[BACK]Return to instructions_f3.c CVS log [TXT] [DIR] Up to [local] / rpl / src

Diff for /rpl/src/instructions_f3.c between versions 1.2 and 1.73

version 1.2, 2010/01/27 22:22:13 version 1.73, 2016/09/27 15:29:35
Line 1 Line 1
 /*  /*
 ================================================================================  ================================================================================
   RPL/2 (R) version 4.0.10    RPL/2 (R) version 4.1.26
   Copyright (C) 1989-2010 Dr. BERTRAND Joël    Copyright (C) 1989-2016 Dr. BERTRAND Joël
   
   This file is part of RPL/2.    This file is part of RPL/2.
   
Line 20 Line 20
 */  */
   
   
 #include "rpl.conv.h"  #include "rpl-conv.h"
   
   
 /*  /*
Line 72  instruction_format(struct_processus *s_e Line 72  instruction_format(struct_processus *s_e
         }          }
   
         printf("    { \"STANDARD*(*)\" }\n");          printf("    { \"STANDARD*(*)\" }\n");
         printf("    { \"lambda\" 'SEQUENTIAL' 'NEW' 'WRITEONLY' 'FORMATTED' }"          printf("    { { \"NAME\" \"lambda\" } \"SEQUENTIAL\" \"NEW\""
                 " OPEN FORMAT\n\n");                  "\"WRITEONLY\" \"FORMATTED\" } OPEN\n            FORMAT\n\n");
   
         if ((*s_etat_processus).langue == 'F')          if ((*s_etat_processus).langue == 'F')
         {          {
Line 96  instruction_format(struct_processus *s_e Line 96  instruction_format(struct_processus *s_e
         printf("    { \"CHARACTER*(*)\" }\n");          printf("    { \"CHARACTER*(*)\" }\n");
         printf("    { \"CHARACTER*(%s)\" }\n", d_INT);          printf("    { \"CHARACTER*(%s)\" }\n", d_INT);
         printf("    { \"BINARY*%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("  UNFORMATTED\n");
         printf("    { \"INTEGER*1\", \"INTEGER*2\", \"INTEGER*4\", "          printf("    { \"INTEGER*1\", \"INTEGER*2\", \"INTEGER*4\", "
Line 105  instruction_format(struct_processus *s_e Line 106  instruction_format(struct_processus *s_e
                 "\"LOGICAL*8\" }\n");                  "\"LOGICAL*8\" }\n");
         printf("    { \"REAL*4\", \"REAL*8\" }\n");          printf("    { \"REAL*4\", \"REAL*8\" }\n");
         printf("    { \"COMPLEX*8\", \"COMPLEX*16\" }\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("  FLOW\n");
         printf("    { \"CHARACTER*(*)\" }\n");  
         printf("    { \"CHARACTER*(%s)\" }\n", d_INT);  
         printf("    { \"LENGTH*(*)\" }\n");          printf("    { \"LENGTH*(*)\" }\n");
         printf("    { \"LENGTH*(%s)\" }\n", d_INT);          printf("    { \"LENGTH*(%s)\" }\n", d_INT);
   
Line 542  instruction_fleche_q(struct_processus *s Line 542  instruction_fleche_q(struct_processus *s
   
             if (y != 0)              if (y != 0)
             {              {
                 z = fabs(objectif - (r1 / r2));                  z = abs(objectif - (r1 / r2));
                 x = ((real8) 1) / y;                  x = ((real8) 1) / y;
             }              }
             else              else
Line 551  instruction_fleche_q(struct_processus *s Line 551  instruction_fleche_q(struct_processus *s
             }              }
         } while(z > epsilon);          } 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;              if ((s_objet_argument_1 = allocation(s_etat_processus, REL))
             return;                      == 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;              if ((s_objet_argument_2 = allocation(s_etat_processus, REL))
             return;                      == 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)          if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
         {          {
Line 926  instruction_fleche_row(struct_processus Line 956  instruction_fleche_row(struct_processus
                 nombre_lignes;                  nombre_lignes;
   
         if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =          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;              (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
             return;              return;
Line 941  instruction_fleche_row(struct_processus Line 971  instruction_fleche_row(struct_processus
             }              }
   
             if ((((integer8 **) (*((struct_matrice *) (*s_objet_resultat)              if ((((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
                     .objet)).tableau)[i] = malloc(nombre_colonnes *                      .objet)).tableau)[i] = malloc(((size_t) nombre_colonnes) *
                     sizeof(integer8))) == NULL)                      sizeof(integer8))) == NULL)
             {              {
                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;                  (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
Line 972  instruction_fleche_row(struct_processus Line 1002  instruction_fleche_row(struct_processus
                 nombre_lignes;                  nombre_lignes;
   
         if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =          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;              (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
             return;              return;
Line 987  instruction_fleche_row(struct_processus Line 1017  instruction_fleche_row(struct_processus
             }              }
   
             if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat)              if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat)
                     .objet)).tableau)[i] = malloc(nombre_colonnes *                      .objet)).tableau)[i] = malloc(((size_t) nombre_colonnes) *
                     sizeof(real8))) == NULL)                      sizeof(real8))) == NULL)
             {              {
                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;                  (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
Line 999  instruction_fleche_row(struct_processus Line 1029  instruction_fleche_row(struct_processus
                 for(j = 0; j < nombre_colonnes; j++)                  for(j = 0; j < nombre_colonnes; j++)
                 {                  {
                     ((real8 **) (*((struct_matrice *) (*s_objet_resultat)                      ((real8 **) (*((struct_matrice *) (*s_objet_resultat)
                             .objet)).tableau)[i][j] = ((integer8 **)                              .objet)).tableau)[i][j] = (real8) ((integer8 **)
                             (*((struct_matrice *) (*s_objet).objet))                              (*((struct_matrice *) (*s_objet).objet))
                             .tableau)[0][j];                              .tableau)[0][j];
                 }                  }
Line 1032  instruction_fleche_row(struct_processus Line 1062  instruction_fleche_row(struct_processus
                 nombre_lignes;                  nombre_lignes;
   
         if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =          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;              (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
             return;              return;
Line 1047  instruction_fleche_row(struct_processus Line 1077  instruction_fleche_row(struct_processus
             }              }
   
             if ((((complex16 **) (*((struct_matrice *) (*s_objet_resultat)              if ((((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
                     .objet)).tableau)[i] = malloc(nombre_colonnes *                      .objet)).tableau)[i] = malloc(((size_t) nombre_colonnes) *
                     sizeof(complex16))) == NULL)                      sizeof(complex16))) == NULL)
             {              {
                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;                  (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
Line 1059  instruction_fleche_row(struct_processus Line 1089  instruction_fleche_row(struct_processus
                 for(j = 0; j < nombre_colonnes; j++)                  for(j = 0; j < nombre_colonnes; j++)
                 {                  {
                     (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)                      (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
                             .objet)).tableau)[i][j]).partie_reelle =                              .objet)).tableau)[i][j]).partie_reelle = (real8)
                             ((integer8 **) (*((struct_matrice *)                              ((integer8 **) (*((struct_matrice *)
                             (*s_objet).objet)).tableau)[0][j];                              (*s_objet).objet)).tableau)[0][j];
                     (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)                      (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
Line 1321  instruction_fleche_col(struct_processus Line 1351  instruction_fleche_col(struct_processus
                 nombre_lignes;                  nombre_lignes;
   
         if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =          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;              (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
             return;              return;
Line 1330  instruction_fleche_col(struct_processus Line 1360  instruction_fleche_col(struct_processus
         for(i = 0; i < nombre_lignes; i++)          for(i = 0; i < nombre_lignes; i++)
         {          {
             if ((((integer8 **) (*((struct_matrice *) (*s_objet_resultat)              if ((((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
                     .objet)).tableau)[i] = malloc(nombre_colonnes *                      .objet)).tableau)[i] = malloc(((size_t) nombre_colonnes) *
                     sizeof(integer8))) == NULL)                      sizeof(integer8))) == NULL)
             {              {
                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;                  (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
Line 1370  instruction_fleche_col(struct_processus Line 1400  instruction_fleche_col(struct_processus
                 nombre_lignes;                  nombre_lignes;
   
         if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =          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;              (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
             return;              return;
Line 1379  instruction_fleche_col(struct_processus Line 1409  instruction_fleche_col(struct_processus
         for(i = 0; i < nombre_lignes; i++)          for(i = 0; i < nombre_lignes; i++)
         {          {
             if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat)              if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat)
                     .objet)).tableau)[i] = malloc(nombre_colonnes *                      .objet)).tableau)[i] = malloc(((size_t) nombre_colonnes) *
                     sizeof(real8))) == NULL)                      sizeof(real8))) == NULL)
             {              {
                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;                  (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
Line 1400  instruction_fleche_col(struct_processus Line 1430  instruction_fleche_col(struct_processus
                 for(i = 0; i < nombre_lignes; i++)                  for(i = 0; i < nombre_lignes; i++)
                 {                  {
                     ((real8 **) (*((struct_matrice *) (*s_objet_resultat)                      ((real8 **) (*((struct_matrice *) (*s_objet_resultat)
                             .objet)).tableau)[i][j] = ((integer8 **)                              .objet)).tableau)[i][j] = (real8) ((integer8 **)
                             (*((struct_matrice *) (*s_objet).objet))                              (*((struct_matrice *) (*s_objet).objet))
                             .tableau)[i][0];                              .tableau)[i][0];
                 }                  }
Line 1433  instruction_fleche_col(struct_processus Line 1463  instruction_fleche_col(struct_processus
                 nombre_lignes;                  nombre_lignes;
   
         if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =          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;              (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
             return;              return;
Line 1442  instruction_fleche_col(struct_processus Line 1472  instruction_fleche_col(struct_processus
         for(i = 0; i < nombre_lignes; i++)          for(i = 0; i < nombre_lignes; i++)
         {          {
             if ((((complex16 **) (*((struct_matrice *) (*s_objet_resultat)              if ((((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
                     .objet)).tableau)[i] = malloc(nombre_colonnes *                      .objet)).tableau)[i] = malloc(((size_t) nombre_colonnes) *
                     sizeof(complex16))) == NULL)                      sizeof(complex16))) == NULL)
             {              {
                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;                  (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
Line 1463  instruction_fleche_col(struct_processus Line 1493  instruction_fleche_col(struct_processus
                 for(i = 0; i < nombre_lignes; i++)                  for(i = 0; i < nombre_lignes; i++)
                 {                  {
                     (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)                      (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
                             .objet)).tableau)[i][j]).partie_reelle =                              .objet)).tableau)[i][j]).partie_reelle = (real8)
                             ((integer8 **) (*((struct_matrice *)                              ((integer8 **) (*((struct_matrice *)
                             (*s_objet).objet)).tableau)[i][0];                              (*s_objet).objet)).tableau)[i][0];
                     (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)                      (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
Line 1599  instruction_fleche_num(struct_processus Line 1629  instruction_fleche_num(struct_processus
             sf(s_etat_processus, 31);              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;          (*s_etat_processus).erreur_execution = d_ex_manque_argument;
         return;          return;
     }      }
Line 1610  instruction_fleche_num(struct_processus Line 1649  instruction_fleche_num(struct_processus
             sf(s_etat_processus, 31);              sf(s_etat_processus, 31);
         }          }
   
           if (registre_type_evaluation == 'E')
           {
               sf(s_etat_processus, 35);
           }
           else
           {
               cf(s_etat_processus, 35);
           }
   
         return;          return;
     }      }
   
Line 1623  instruction_fleche_num(struct_processus Line 1671  instruction_fleche_num(struct_processus
             sf(s_etat_processus, 31);              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);          liberation(s_etat_processus, s_objet);
         return;          return;
     }      }
Line 1758  instruction_fuse(struct_processus *s_eta Line 1815  instruction_fuse(struct_processus *s_eta
         return;          return;
     }      }
   
   #   ifdef SCHED_OTHER
     if (pthread_attr_setschedpolicy(&attributs, SCHED_OTHER) != 0)      if (pthread_attr_setschedpolicy(&attributs, SCHED_OTHER) != 0)
     {      {
         (*s_etat_processus).erreur_systeme = d_es_processus;          (*s_etat_processus).erreur_systeme = d_es_processus;
         return;          return;
     }      }
   #   endif
   
   #   ifdef PTHREAD_EXPLICIT_SCHED
     if (pthread_attr_setinheritsched(&attributs,      if (pthread_attr_setinheritsched(&attributs,
             PTHREAD_EXPLICIT_SCHED) != 0)              PTHREAD_EXPLICIT_SCHED) != 0)
     {      {
         (*s_etat_processus).erreur_systeme = d_es_processus;          (*s_etat_processus).erreur_systeme = d_es_processus;
         return;          return;
     }      }
   #   endif
   
   #   ifdef PTHREAD_SCOPE_SYSTEM
     if (pthread_attr_setscope(&attributs, PTHREAD_SCOPE_SYSTEM) != 0)      if (pthread_attr_setscope(&attributs, PTHREAD_SCOPE_SYSTEM) != 0)
     {      {
         (*s_etat_processus).erreur_systeme = d_es_processus;          (*s_etat_processus).erreur_systeme = d_es_processus;
         return;          return;
     }      }
   #   endif
   
     if (pthread_create(&(*s_etat_processus).thread_fusible, &attributs,       if (pthread_create(&(*s_etat_processus).thread_fusible, &attributs, 
             fusible, s_etat_processus) != 0)              fusible, s_etat_processus) != 0)
Line 1783  instruction_fuse(struct_processus *s_eta Line 1846  instruction_fuse(struct_processus *s_eta
         (*s_etat_processus).erreur_systeme = d_es_processus;          (*s_etat_processus).erreur_systeme = d_es_processus;
         return;          return;
     }      }
       
     if (pthread_attr_destroy(&attributs) != 0)      if (pthread_attr_destroy(&attributs) != 0)
     {      {
         (*s_etat_processus).erreur_systeme = d_es_processus;          (*s_etat_processus).erreur_systeme = d_es_processus;
Removed from v.1.2  
changed lines
  Added in v.1.73

CVSweb interface <joel.bertrand@systella.fr>