--- rpl/src/instructions_f3.c 2010/02/10 10:14:22 1.3 +++ rpl/src/instructions_f3.c 2013/02/26 19:56:14 1.53 @@ -1,7 +1,7 @@ /* ================================================================================ - RPL/2 (R) version 4.0.11 - Copyright (C) 1989-2010 Dr. BERTRAND Joël + RPL/2 (R) version 4.1.12 + Copyright (C) 1989-2013 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') { @@ -108,8 +108,6 @@ instruction_format(struct_processus *s_e printf(" { \"CHARACTER\" }\n\n"); printf(" FLOW\n"); - printf(" { \"CHARACTER*(*)\" }\n"); - printf(" { \"CHARACTER*(%s)\" }\n", d_INT); printf(" { \"LENGTH*(*)\" }\n"); printf(" { \"LENGTH*(%s)\" }\n", d_INT); @@ -551,21 +549,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) { @@ -1599,6 +1627,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 +1647,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 +1669,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 +1813,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 +1844,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;