Diff for /rpl/src/instructions_f3.c between versions 1.16 and 1.79

version 1.16, 2010/08/06 15:26:47 version 1.79, 2018/12/24 15:55:42
Line 1 Line 1
 /*  /*
 ================================================================================  ================================================================================
   RPL/2 (R) version 4.0.18    RPL/2 (R) version 4.1.30
   Copyright (C) 1989-2010 Dr. BERTRAND Joël    Copyright (C) 1989-2018 Dr. BERTRAND Joël
   
   This file is part of RPL/2.    This file is part of RPL/2.
   
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);
           printf("    { \"LINE*(*)\" }\n", d_INT);
   
         return;          return;
     }      }
Line 542  instruction_fleche_q(struct_processus *s Line 543  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 956  instruction_fleche_row(struct_processus Line 957  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 971  instruction_fleche_row(struct_processus Line 972  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 1002  instruction_fleche_row(struct_processus Line 1003  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 1017  instruction_fleche_row(struct_processus Line 1018  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 1029  instruction_fleche_row(struct_processus Line 1030  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 1062  instruction_fleche_row(struct_processus Line 1063  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 1077  instruction_fleche_row(struct_processus Line 1078  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 1089  instruction_fleche_row(struct_processus Line 1090  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 1351  instruction_fleche_col(struct_processus Line 1352  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 1360  instruction_fleche_col(struct_processus Line 1361  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 1400  instruction_fleche_col(struct_processus Line 1401  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 1409  instruction_fleche_col(struct_processus Line 1410  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 1430  instruction_fleche_col(struct_processus Line 1431  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 1463  instruction_fleche_col(struct_processus Line 1464  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 1472  instruction_fleche_col(struct_processus Line 1473  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 1493  instruction_fleche_col(struct_processus Line 1494  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 1629  instruction_fleche_num(struct_processus Line 1630  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 1640  instruction_fleche_num(struct_processus Line 1650  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 1653  instruction_fleche_num(struct_processus Line 1672  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 1788  instruction_fuse(struct_processus *s_eta Line 1816  instruction_fuse(struct_processus *s_eta
         return;          return;
     }      }
   
 #   ifndef OS2  #   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;

Removed from v.1.16  
changed lines
  Added in v.1.79


CVSweb interface <joel.bertrand@systella.fr>