--- rpl/src/instructions_f3.c 2010/01/26 15:22:44 1.1 +++ rpl/src/instructions_f3.c 2019/01/01 09:02:57 1.80 @@ -1,7 +1,7 @@ /* ================================================================================ - RPL/2 (R) version 4.0.9 - Copyright (C) 1989-2010 Dr. BERTRAND Joël + RPL/2 (R) version 4.1.30 + 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" /* @@ -72,8 +72,8 @@ instruction_format(struct_processus *s_e } printf(" { \"STANDARD*(*)\" }\n"); - printf(" { \"lambda\" 'SEQUENTIAL' 'NEW' 'WRITEONLY' 'FORMATTED' }" - " OPEN FORMAT\n\n"); + printf(" { { \"NAME\" \"lambda\" } \"SEQUENTIAL\" \"NEW\"" + "\"WRITEONLY\" \"FORMATTED\" } OPEN\n FORMAT\n\n"); if ((*s_etat_processus).langue == 'F') { @@ -96,7 +96,8 @@ instruction_format(struct_processus *s_e printf(" { \"CHARACTER*(*)\" }\n"); printf(" { \"CHARACTER*(%s)\" }\n", d_INT); printf(" { \"BINARY*%s(*)\" }\n", d_INT); - printf(" { \"BINARY*%s(%s)\" }\n\n", d_INT, 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\", " @@ -105,13 +106,13 @@ instruction_format(struct_processus *s_e "\"LOGICAL*8\" }\n"); printf(" { \"REAL*4\", \"REAL*8\" }\n"); printf(" { \"COMPLEX*8\", \"COMPLEX*16\" }\n"); - printf(" { \"CHARACTER\" }\n\n"); + printf(" { \"CHARACTER*(*)\", \"CHARACTER*(%s)\" }\n", d_INT); + printf(" { \"NATIVE*(*)\" }\n\n"); printf(" FLOW\n"); - printf(" { \"CHARACTER*(*)\" }\n"); - printf(" { \"CHARACTER*(%s)\" }\n", d_INT); printf(" { \"LENGTH*(*)\" }\n"); printf(" { \"LENGTH*(%s)\" }\n", d_INT); + printf(" { \"LINE*(*)\" }\n", d_INT); return; } @@ -542,7 +543,7 @@ instruction_fleche_q(struct_processus *s if (y != 0) { - z = fabs(objectif - (r1 / r2)); + z = abs(objectif - (r1 / r2)); x = ((real8) 1) / y; } else @@ -551,21 +552,51 @@ instruction_fleche_q(struct_processus *s } } while(z > epsilon); - if ((s_objet_argument_1 = allocation(s_etat_processus, REL)) == NULL) + if (r2 != ((real8) ((integer8) r2))) { - (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; - return; + 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; + } - (*((real8 *) (*s_objet_argument_1).objet)) = r2; + (*((integer8 *) (*s_objet_argument_1).objet)) = (integer8) r2; + } - if ((s_objet_argument_2 = allocation(s_etat_processus, REL)) == NULL) + if (r1 != ((real8) ((integer8) r1))) { - (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; - return; + 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; + } - (*((real8 *) (*s_objet_argument_2).objet)) = r1; + (*((integer8 *) (*s_objet_argument_2).objet)) = (integer8) r1; + } if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL) { @@ -926,7 +957,7 @@ instruction_fleche_row(struct_processus nombre_lignes; if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau = - malloc(nombre_lignes * sizeof(integer8 *))) == NULL) + malloc(((size_t) nombre_lignes) * sizeof(integer8 *))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; @@ -941,7 +972,7 @@ instruction_fleche_row(struct_processus } if ((((integer8 **) (*((struct_matrice *) (*s_objet_resultat) - .objet)).tableau)[i] = malloc(nombre_colonnes * + .objet)).tableau)[i] = malloc(((size_t) nombre_colonnes) * sizeof(integer8))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; @@ -972,7 +1003,7 @@ instruction_fleche_row(struct_processus nombre_lignes; if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau = - malloc(nombre_lignes * sizeof(real8 *))) == NULL) + malloc(((size_t) nombre_lignes) * sizeof(real8 *))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; @@ -987,7 +1018,7 @@ instruction_fleche_row(struct_processus } if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat) - .objet)).tableau)[i] = malloc(nombre_colonnes * + .objet)).tableau)[i] = malloc(((size_t) nombre_colonnes) * sizeof(real8))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; @@ -999,7 +1030,7 @@ instruction_fleche_row(struct_processus for(j = 0; j < nombre_colonnes; j++) { ((real8 **) (*((struct_matrice *) (*s_objet_resultat) - .objet)).tableau)[i][j] = ((integer8 **) + .objet)).tableau)[i][j] = (real8) ((integer8 **) (*((struct_matrice *) (*s_objet).objet)) .tableau)[0][j]; } @@ -1032,7 +1063,7 @@ instruction_fleche_row(struct_processus nombre_lignes; if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau = - malloc(nombre_lignes * sizeof(complex16 *))) == NULL) + malloc(((size_t) nombre_lignes) * sizeof(complex16 *))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; @@ -1047,7 +1078,7 @@ instruction_fleche_row(struct_processus } if ((((complex16 **) (*((struct_matrice *) (*s_objet_resultat) - .objet)).tableau)[i] = malloc(nombre_colonnes * + .objet)).tableau)[i] = malloc(((size_t) nombre_colonnes) * sizeof(complex16))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; @@ -1059,7 +1090,7 @@ instruction_fleche_row(struct_processus for(j = 0; j < nombre_colonnes; j++) { (((complex16 **) (*((struct_matrice *) (*s_objet_resultat) - .objet)).tableau)[i][j]).partie_reelle = + .objet)).tableau)[i][j]).partie_reelle = (real8) ((integer8 **) (*((struct_matrice *) (*s_objet).objet)).tableau)[0][j]; (((complex16 **) (*((struct_matrice *) (*s_objet_resultat) @@ -1321,7 +1352,7 @@ instruction_fleche_col(struct_processus nombre_lignes; if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau = - malloc(nombre_lignes * sizeof(integer8 *))) == NULL) + malloc(((size_t) nombre_lignes) * sizeof(integer8 *))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; @@ -1330,7 +1361,7 @@ instruction_fleche_col(struct_processus for(i = 0; i < nombre_lignes; i++) { if ((((integer8 **) (*((struct_matrice *) (*s_objet_resultat) - .objet)).tableau)[i] = malloc(nombre_colonnes * + .objet)).tableau)[i] = malloc(((size_t) nombre_colonnes) * sizeof(integer8))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; @@ -1370,7 +1401,7 @@ instruction_fleche_col(struct_processus nombre_lignes; if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau = - malloc(nombre_lignes * sizeof(real8 *))) == NULL) + malloc(((size_t) nombre_lignes) * sizeof(real8 *))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; @@ -1379,7 +1410,7 @@ instruction_fleche_col(struct_processus for(i = 0; i < nombre_lignes; i++) { if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat) - .objet)).tableau)[i] = malloc(nombre_colonnes * + .objet)).tableau)[i] = malloc(((size_t) nombre_colonnes) * sizeof(real8))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; @@ -1400,7 +1431,7 @@ instruction_fleche_col(struct_processus for(i = 0; i < nombre_lignes; i++) { ((real8 **) (*((struct_matrice *) (*s_objet_resultat) - .objet)).tableau)[i][j] = ((integer8 **) + .objet)).tableau)[i][j] = (real8) ((integer8 **) (*((struct_matrice *) (*s_objet).objet)) .tableau)[i][0]; } @@ -1433,7 +1464,7 @@ instruction_fleche_col(struct_processus nombre_lignes; if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau = - malloc(nombre_lignes * sizeof(complex16 *))) == NULL) + malloc(((size_t) nombre_lignes) * sizeof(complex16 *))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; @@ -1442,7 +1473,7 @@ instruction_fleche_col(struct_processus for(i = 0; i < nombre_lignes; i++) { if ((((complex16 **) (*((struct_matrice *) (*s_objet_resultat) - .objet)).tableau)[i] = malloc(nombre_colonnes * + .objet)).tableau)[i] = malloc(((size_t) nombre_colonnes) * sizeof(complex16))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; @@ -1463,7 +1494,7 @@ instruction_fleche_col(struct_processus for(i = 0; i < nombre_lignes; i++) { (((complex16 **) (*((struct_matrice *) (*s_objet_resultat) - .objet)).tableau)[i][j]).partie_reelle = + .objet)).tableau)[i][j]).partie_reelle = (real8) ((integer8 **) (*((struct_matrice *) (*s_objet).objet)).tableau)[i][0]; (((complex16 **) (*((struct_matrice *) (*s_objet_resultat) @@ -1599,6 +1630,15 @@ instruction_fleche_num(struct_processus 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; } @@ -1610,6 +1650,15 @@ instruction_fleche_num(struct_processus sf(s_etat_processus, 31); } + if (registre_type_evaluation == 'E') + { + sf(s_etat_processus, 35); + } + else + { + cf(s_etat_processus, 35); + } + return; } @@ -1623,6 +1672,15 @@ instruction_fleche_num(struct_processus 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; } @@ -1758,24 +1816,30 @@ instruction_fuse(struct_processus *s_eta 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) @@ -1783,7 +1847,7 @@ instruction_fuse(struct_processus *s_eta (*s_etat_processus).erreur_systeme = d_es_processus; return; } - + if (pthread_attr_destroy(&attributs) != 0) { (*s_etat_processus).erreur_systeme = d_es_processus;