Diff for /rpl/src/instructions_f3.c between versions 1.28 and 1.80

version 1.28, 2011/06/20 17:54:17 version 1.80, 2019/01/01 09:02:57
Line 1 Line 1
 /*  /*
 ================================================================================  ================================================================================
   RPL/2 (R) version 4.1.0.prerelease.1    RPL/2 (R) version 4.1.30
   Copyright (C) 1989-2011 Dr. BERTRAND Joël    Copyright (C) 1989-2019 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 148  instruction_format(struct_processus *s_e Line 149  instruction_format(struct_processus *s_e
     if (((*s_objet_argument_1).type == FCH) &&      if (((*s_objet_argument_1).type == FCH) &&
             ((*s_objet_argument_2).type == LST))              ((*s_objet_argument_2).type == LST))
     {      {
         if ((*((struct_fichier *) (*s_objet_argument_1).objet)).binaire  
                 == 'F')  
         {  
             liberation(s_etat_processus, s_objet_argument_1);  
             liberation(s_etat_processus, s_objet_argument_2);  
   
             (*s_etat_processus).erreur_execution =  
                     d_ex_erreur_format_fichier;  
             return;  
         }  
   
         if ((s_copie_argument_1 = copie_objet(s_etat_processus,          if ((s_copie_argument_1 = copie_objet(s_etat_processus,
                 s_objet_argument_1, 'N')) == NULL)                  s_objet_argument_1, 'N')) == NULL)
         {          {
Line 178  instruction_format(struct_processus *s_e Line 168  instruction_format(struct_processus *s_e
     else if (((*s_objet_argument_1).type == SCK) &&      else if (((*s_objet_argument_1).type == SCK) &&
             ((*s_objet_argument_2).type == LST))              ((*s_objet_argument_2).type == LST))
     {      {
         if ((*((struct_socket *) (*s_objet_argument_1).objet)).binaire  
                 == 'F')  
         {  
             liberation(s_etat_processus, s_objet_argument_1);  
             liberation(s_etat_processus, s_objet_argument_2);  
   
             (*s_etat_processus).erreur_execution =  
                     d_ex_erreur_format_fichier;  
             return;  
         }  
   
         if ((s_copie_argument_1 = copie_objet(s_etat_processus,          if ((s_copie_argument_1 = copie_objet(s_etat_processus,
                 s_objet_argument_1, 'N')) == NULL)                  s_objet_argument_1, 'N')) == NULL)
         {          {
Line 564  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 978  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 993  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 1024  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 1039  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 1051  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 1084  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 1099  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 1111  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 1373  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 1382  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 1422  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 1431  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 1452  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 1485  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 1494  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 1515  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 1837  instruction_fuse(struct_processus *s_eta Line 1816  instruction_fuse(struct_processus *s_eta
         return;          return;
     }      }
   
 #   ifndef OS2  #   ifdef SCHED_OTHER
 #   ifndef Cygwin  
     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  #   endif
 #   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)

Removed from v.1.28  
changed lines
  Added in v.1.80


CVSweb interface <joel.bertrand@systella.fr>