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

version 1.2, 2010/01/27 22:22:13 version 1.46, 2012/06/22 10:12:19
Line 1 Line 1
 /*  /*
 ================================================================================  ================================================================================
   RPL/2 (R) version 4.0.10    RPL/2 (R) version 4.1.9
   Copyright (C) 1989-2010 Dr. BERTRAND Joël    Copyright (C) 1989-2012 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 108  instruction_format(struct_processus *s_e Line 108  instruction_format(struct_processus *s_e
         printf("    { \"CHARACTER\" }\n\n");          printf("    { \"CHARACTER\" }\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 148  instruction_format(struct_processus *s_e Line 146  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 167  instruction_format(struct_processus *s_e Line 176  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 551  instruction_fleche_q(struct_processus *s Line 571  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 1599  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);
           }
   
         (*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 1669  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 1691  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 1835  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 1866  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.46


CVSweb interface <joel.bertrand@systella.fr>