/*************************************************************************************************************************************/ /* */ /* D E F I N I T I O N S G E N E R A L E S P E U U S I T E E S : */ /* */ /* */ /* Definition : */ /* */ /* Dans ce fichier, se trouvent */ /* les definitions permettant le */ /* parametrage absolu, la gestion */ /* du parallelisme... */ /* */ /* */ /* Author of '$xig/defin_2$vv$DEF' : */ /* */ /* Jean-Francois COLONNA (LACTAMME, 19870000000000). */ /* */ /*************************************************************************************************************************************/ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* E Q U I V A L E N C E " E N T I E R " / " F L O T T A N T " T Y P E F O R T R A N */ /* R E I N T R O D U I T L E 20021103115726 A C A U S E D E ' $xrk/verhulst.??$K ' : */ /* */ /*************************************************************************************************************************************/ Dunion_02(Flint ,DEFV(Int,InT) /* Pour acceder a la valeur en entier (attention au 'T'...), */ ,DEFV(vrai_Float_de_base,FloaT) /* Pour acceder a la valeur en flottant (attention au 'T'...). */ ,NOM_VIDE ); /* L'union ainsi definie s'appelle "Flint", */ TypedefP(flint,UNIO(Flint)) /* Le type ainsi defini s'appelle "flint". */ #define flint_InT(argument) \ ASD1(argument,InT) #define flint_FloaT(argument) \ ASD1(argument,FloaT) /* Procedures d'acces introduites le 20040323092134. */ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* E Q U I V A L E N C E " E N T I E R " / " F L O T T A N T " T Y P E F O R T R A N */ /* D E S T I N E E A U X I M P R E S S I O N S H E X A - D E C I M A L E S : */ /* */ /*************************************************************************************************************************************/ Dunion_02(EquivalenceFloatInt ,DEFV(Float,VersionFlottante) /* Contient la valeur 'Float'. */ ,Dstruct02(VersionInt ,DEFV(Int,VersionInt_1) /* Contient la premiere partie de la valeur 'Int'. */ ,DEFV(Int,VersionInt_2) /* Contient la deuxieme partie de la valeur 'Int'. */ ,VersionInt ) /* Contient la valeur representee sous forme de deux 'Int's. */ ,NOM_VIDE ); TypedefP(FloatInt,UNIO(EquivalenceFloatInt)) /* Pour definir une equivalence {Float,Int} destinee a des editions hexa-decimales */ /* (introduit le 20040323092134). */ #define FloatInt_Float(argument) \ ASD1(argument,VersionFlottante) #define FloatInt_Int_1(argument) \ ASD2(argument,VersionInt,VersionInt_1) #define FloatInt_Int_2(argument) \ ASD2(argument,VersionInt,VersionInt_2) /* Procedures d'acces... */ #if ( (defined(SYSTEME_APC_LinuxDebian_GCC)) \ || (defined(SYSTEME_APC_LinuxMandrake_GCC)) \ || (defined(SYSTEME_APC_LinuxRedHat_GCC)) \ || (defined(SYSTEME_APC_LinuxUbuntu_GCC)) \ || (defined(SYSTEME_APC_LinuxUbuntu_ICC)) \ || (defined(SYSTEME_APC_LinuxUlmint_GCC)) \ || (defined(SYSTEME_APC_LinuxUlmint_ICC)) \ ) # define IMPRESSION_D_UN_NOMBRE_FloatInt(nombre_flottant,MessageDebut,MessageFin) \ Bblock \ DEFV(FloatInt,nombre_flottant_en_Float); \ \ EGAL(FloatInt_Float(nombre_flottant_en_Float),nombre_flottant); \ \ CAL3(Prme1("%s",MessageDebut)); \ CAL3(Prme3("%+.^^^={0x%08x,0x%08x}" \ ,FloatInt_Float(nombre_flottant_en_Float) \ ,FloatInt_Int_2(nombre_flottant_en_Float) \ ,FloatInt_Int_1(nombre_flottant_en_Float) \ ) \ ); \ /* Le 20091123122701, le format "^^g" est passe a "^^^" pour plus de souplesse... */ \ CAL3(Prme1("%s",MessageFin)); \ Eblock \ /* Procedure introduite le 20080925090635 pour 'v $xiii/aleat.2$vv$FON 20080924174528'... */ #Aif ( (defined(SYSTEME_APC_LinuxDebian_GCC)) \ || (defined(SYSTEME_APC_LinuxMandrake_GCC)) \ || (defined(SYSTEME_APC_LinuxRedHat_GCC)) \ || (defined(SYSTEME_APC_LinuxUbuntu_GCC)) \ || (defined(SYSTEME_APC_LinuxUbuntu_ICC)) \ || (defined(SYSTEME_APC_LinuxUlmint_GCC)) \ || (defined(SYSTEME_APC_LinuxUlmint_ICC)) \ ) # define IMPRESSION_D_UN_NOMBRE_FloatInt(nombre_flottant,MessageDebut,MessageFin) \ Bblock \ DEFV(FloatInt,nombre_flottant_en_Float); \ \ EGAL(FloatInt_Float(nombre_flottant_en_Float),nombre_flottant); \ \ CAL3(Prme1("%s",MessageDebut)); \ CAL3(Prme3("%+.^^^={0x%08x,0x%08x}" \ ,FloatInt_Float(nombre_flottant_en_Float) \ ,FloatInt_Int_1(nombre_flottant_en_Float) \ ,FloatInt_Int_2(nombre_flottant_en_Float) \ ) \ ); \ /* Le 20091123122701, le format "^^g" est passe a "^^^" pour plus de souplesse... */ \ CAL3(Prme1("%s",MessageFin)); \ Eblock \ /* Procedure introduite le 20080925090635 pour 'v $xiii/aleat.2$vv$FON 20080924174528'... */ #Eif ( (defined(SYSTEME_APC_LinuxDebian_GCC)) \ || (defined(SYSTEME_APC_LinuxMandrake_GCC)) \ || (defined(SYSTEME_APC_LinuxRedHat_GCC)) \ || (defined(SYSTEME_APC_LinuxUbuntu_GCC)) \ || (defined(SYSTEME_APC_LinuxUbuntu_ICC)) \ || (defined(SYSTEME_APC_LinuxUlmint_GCC)) \ || (defined(SYSTEME_APC_LinuxUlmint_ICC)) \ ) /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* O U T I L S T Y P E " L A N G A G E O B J E T " */ /* R E I N T R O D U I T L E 20021103115726 ( A U C A S O U ) : */ /* */ /* */ /* Nota : */ /* */ /* Le 20100209104454 le nom des procedures 'Tx(...)' */ /* a ete change en 'LoTx(...)' a cause de l'introduction */ /* dans 'v $xiii/mono_image$DEF 20100209085255' de la */ /* de la quatrieme dimension ('Tf')... */ /* */ /*************************************************************************************************************************************/ Dstruct02(ITEM ,DEFV(Int,tag) /* Contient le type de la valeur qui suit. */ ,Dunion_06(NOM_VIDE ,DEFV(CHAR,CAR) /* Type "CHAR", */ ,DEFV(ShortInt,SHORT) /* Type "Short Int", */ ,DEFV(Int,INT) /* Type "Int", */ ,DEFV(Positive,UNSIGNED) /* Type "Positive", */ ,DEFV(LongInt,LONG) /* Type "Long Int", */ ,DEFV(Float,FLOAT) /* Type "Float". */ ,valeur ) /* Valeur proprement dite... */ ,NOM_VIDE ); TypedefP(item,STRU(ITEM)) /* Pour definir une valeur "tagee"... */ #define LoTt(argument) \ ASD1(argument,tag) \ /* Acces au "tag" ; ces valeurs possibles sont les suivantes : */ #define tag_CAR \ bADD(ZERO,I) #define tag_SHORT \ bADD(tag_CAR,I) #define tag_INT \ bADD(tag_SHORT,I) #define tag_UNSIGNED \ bADD(tag_INT,I) #define tag_LONG \ bADD(tag_UNSIGNED,I) #define tag_FLOAT \ bADD(tag_LONG,I) /* Et l'acces aux valeurs se fait par les fonctions : */ #define val(argument,TAG) \ ASD2(argument,valeur,TAG) #define LoTc(argument) \ val(argument,CAR) #define LoTs(argument) \ val(argument,SHORT) #define LoTi(argument) \ val(argument,INT) #define LoTu(argument) \ val(argument,UNSIGNED) #define LoTl(argument) \ val(argument,LONG) #define LoTf(argument) \ val(argument,FLOAT) /* Les fonctions 'v' et 'sv' permettent respectivement de recuperer */ /* une valeur correctement suivant son "tag" de type, et de mettre */ /* en place une valeur et le "tag" associe : */ #define LoTv(argument) \ COND(IFEQ(LoTt(argument),tag_CAR),Fneutre(LoTc(argument)) \ ,COND(IFEQ(LoTt(argument),tag_SHORT),Fneutre(LoTs(argument)) \ ,COND(IFEQ(LoTt(argument),tag_INT),Fneutre(LoTi(argument)) \ ,COND(IFEQ(LoTt(argument),tag_UNSIGNED),Fneutre(LoTu(argument)) \ ,COND(IFEQ(LoTt(argument),tag_LONG),Fneutre(LoTl(argument)) \ ,COND(IFEQ(LoTt(argument),tag_FLOAT),Fneutre(LoTf(argument)) \ ,UNDEF \ ) \ ) \ ) \ ) \ ) \ ) \ /* NOTA : on utilise la fonction 'Fneutre' afin d'inhiber la conversion */ \ /* flottante systematique effectuee par le compilateur ; de plus, cette */ \ /* fonction etant de type 'Int', on ne peut definir 'tag_DOUBLE' pour */ \ /* lequel les valeurs demanderaient 64 bits... */ #define tv(argument,TAG,TYPE) \ Bblock \ EGAL(LoTt(argument),TAG); \ /* On positionne le "TAG" ('tag_CAR', 'tag_SHORT',... de la valeur, */ \ val(argument,TYPE); \ Eblock \ /* Et la valeur proprement dite dans son TYPE ('CAR', 'SHORT',...)... */ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* P R O C E D U R E S D E S T I N E E S A L ' O P T I M I S A T I O N D E S C O N S T A N T E S : */ /* */ /* */ /* Nota : */ /* */ /* Les primitives du type 'DEFINEX(...)' */ /* sont utilisees uniquement dans le */ /* programme 'v $xcp/Konstantes$K'... */ /* */ /*************************************************************************************************************************************/ #define __LIMITEUR_DES_CHAMPS_DES_DEFINES \ UN \ /* Nota : ci-apres, le 'SOUS(...,__LIMITEUR_DES_CHAMPS_DES_DEFINES)' est du a l'espace qui */ \ /* est utilise dans le 'Print' comme limiteur des differents champs, comme par exemple */ \ /* dans : */ \ /* */ \ /* "%-*s %-*d" */ \ /* . */ \ /* /|\ */ \ /* | */ \ /* | */ \ /* */ \ /* De plus, lorsque l'on rencontre 'SOUS(__TAB2,NEUT(...))' destine a modifier '__TAB2', */ \ /* c'est que le format n'est pas "standard" ; par exemple l'heXa-decimal rajoute '0x', et */ \ /* les chaines -String- de caracteres deux quotes '"'... */ #define __ZONE_SYMBOLE \ CINQUANTE #define __TAB1 \ bSOU(__ZONE_SYMBOLE,__LIMITEUR_DES_CHAMPS_DES_DEFINES) /* Longueur de la zone symbole : 50-1 (debut 10, fin 60), */ #if (PRECISION_DU_Int==SIMPLE_PRECISION) # define __ZONE_VALEUR \ TRENTE \ /* Le 20120501184143, a cause de 'v $xcp/Konstantes$K INVERSE_DU_NOMBRE_D_OR', la valeur */ \ /* 'VINGT' a ete augmentee par remplacement par 'TRENTE'... */ #Aif (PRECISION_DU_Int==SIMPLE_PRECISION) #Eif (PRECISION_DU_Int==SIMPLE_PRECISION) #if (PRECISION_DU_Int==DOUBLE_PRECISION) # define __ZONE_VALEUR \ QUARANTE \ /* Introduit le 20100319144435... */ #Aif (PRECISION_DU_Int==DOUBLE_PRECISION) #Eif (PRECISION_DU_Int==DOUBLE_PRECISION) #define __TAB2 \ bSOU(__ZONE_VALEUR,__LIMITEUR_DES_CHAMPS_DES_DEFINES) \ /* Longueur de la zone valeur : 20-1 (debut 60, fin 80), */ #define __ZONE_COMMENTAIRE \ CINQUANTE #define __TAB3 \ bSOU(__ZONE_COMMENTAIRE,__LIMITEUR_DES_CHAMPS_DES_DEFINES) /* Longueur de la zone commentaire : 50-1 (debut 80, fin 130). */ #define __SLASH \ C_SLASH #define __STAR \ C_ETOILE #define MESSAGE(message_a_editer) \ Bblock \ DEFV(CHAR,INIC(POINTERc(format_EGAq____MESSAGE) \ ,chain_Aconcaten2(cINTRODUCTION_DES_DIRECTIVES_DU_PREPROCESSEUR_cpp \ ,"message \"%s\"\n" \ ) \ ) \ ); \ \ CAL2(Prin1(format_EGAq____MESSAGE \ ,message_a_editer \ ) \ ); \ \ CALZ_FreCC(format_EGAq____MESSAGE); \ Eblock \ /* Edition d'un message d'avertissement destine a '$xcp/ccp$X' (en fait, cela semble n'etre */ \ /* utilise que dans 'v $xcp/Bugs$K MESSAGE'). */ #if ( (! defined(BUG_SYSTEME_C_caster_0x)) \ ) # define DEFINEX(nom,valeur,commentaire) \ Bblock \ DEFV(CHAR,INIC(POINTERc(format_EGAq____DEFINEX) \ ,chain_Aconcaten2(cINTRODUCTION_DES_DIRECTIVES_DU_PREPROCESSEUR_cpp \ ,"define %-*s 0x%-0*.*x %s%s %-*s %s%s\n" \ ) \ ) \ ); \ \ CAL2(Prin11(format_EGAq____DEFINEX \ ,__TAB1,nom \ ,bSOU(__TAB2,NEUT(DEUX)),NCHXMO,INTE(valeur) \ ,__SLASH,__STAR \ ,__TAB3,commentaire \ ,__STAR,__SLASH \ ) \ ); \ \ CALZ_FreCC(format_EGAq____DEFINEX); \ Eblock \ /* Definition d'une constante "heXa-decimale". */ \ /* */ \ /* ATTENTION, On notera l'introduction recente d'un "cast" 'INTE(valeur)' sur la valeur a */ \ /* editer ; en effet ceci a ete introduit de facon generale, mais lie en fait au bug */ \ /* 'BUG_SYSTEME_SGIND?GA_IRIX_CC_divisions_entieres' qui est traite par la procedure */ \ /* 'DIVn(...)' qui peut donc, lorsque ce bug est present, demander ici l'impression en */ \ /* format "%x" de valeurs flottantes (puisque evaluees via un 'FLOT(...)' dans 'DIVn(...)'). */ \ /* */ \ /* La constante 'NCHXMO' (=bDIV(NBITMO,NBITHX)' fut introduite le 20051210175325... */ #Aif ( (! defined(BUG_SYSTEME_C_caster_0x)) \ ) /* Le compilateur '$Cc' demande a ce que les constantes hexa-decimales soient castees... */ /* */ /* En ce qui concerne 'SYSTEME_APC_LinuxRedHat_GCC', cela a ete introduit le 19990818123236 */ /* lors de tests des commandes du type 'v $xci/z_carre.01$K' qui font appel a des fonctions */ /* du type 'Iz_au_carre_dans_le_plan_image(...)' defines dans 'v $ximcf/conformes$FON'). */ /* Elles font usage de 'VINTE(...)' et donc de 'IFINff(x,FLOT(MOINS_L_INFINI),FLOT(INFINI))' */ /* ce test 'IFINff(...)' se retrouvant alors incorrect, les signes de 'MOINS_L_INFINI' et de */ /* 'INFINI' etant apparemment incorrects... */ # if (PRECISION_DU_Int==SIMPLE_PRECISION) # define FORMAT_Int_DEFINEX \ "x" # define CAST_Int_DEFINEX \ "(int)" /* Introduit le 20100319220501... */ # Aif (PRECISION_DU_Int==SIMPLE_PRECISION) # Eif (PRECISION_DU_Int==SIMPLE_PRECISION) # if (PRECISION_DU_Int==DOUBLE_PRECISION) # define FORMAT_Int_DEFINEX \ "lx" # define CAST_Int_DEFINEX \ "(long int)" /* Introduit le 20100319220501... */ /* */ /* La forme "%lx" est redondante avec 'v $xig/fonct$vv$FON 20100322120925', mais je le */ /* laisse ainsi, on ne sait jamais... */ # Aif (PRECISION_DU_Int==DOUBLE_PRECISION) # Eif (PRECISION_DU_Int==DOUBLE_PRECISION) # define DEFINEX(nom,valeur,commentaire) \ Bblock \ DEFV(CHAR,INIC(POINTERc(format_EGAq_1____DEFINEX) \ ,chain_Aconcaten3("define %-*s %s0x%-0*.*" \ ,FORMAT_Int_DEFINEX \ ," %s%s %-*s %s%s\n" \ ) \ ) \ ); \ DEFV(CHAR,INIC(POINTERc(format_EGAq_2____DEFINEX),CHAINE_UNDEF)); \ \ EGAp(format_EGAq_2____DEFINEX \ ,chain_Aconcaten2(cINTRODUCTION_DES_DIRECTIVES_DU_PREPROCESSEUR_cpp \ ,format_EGAq_1____DEFINEX \ ) \ ); \ \ CAL2(Prin12(format_EGAq_2____DEFINEX \ ,__TAB1,nom \ ,CAST_Int_DEFINEX \ ,bSOU(__TAB2,NEUT(bADD(DEUX,chain_Xtaille(CAST_Int_DEFINEX)))),NCHXMO,INTE(valeur) \ ,__SLASH,__STAR \ ,__TAB3,commentaire \ ,__STAR,__SLASH \ ) \ ); \ \ CALZ_FreCC(format_EGAq_2____DEFINEX); \ CALZ_FreCC(format_EGAq_1____DEFINEX); \ Eblock \ /* Definition d'une constante "heXa-decimale". On notera la presence d'un "cast" en entier */ \ /* "(int)0x", ce defaut faisant l'objet de l'appel 15070 du 1994012400. On pourra voir a ce */ \ /* propos le programme 'v $Dbugs/SGIND4GA$D/IRIX$D/CC$D/infini.01$c'... */ \ /* */ \ /* ATTENTION, on notera l'introduction recente d'un "cast" 'INTE(valeur)' sur la valeur a */ \ /* editer ; en effet ceci a ete introduit de facon generale, mais lie en fait au bug */ \ /* 'BUG_SYSTEME_SGIND?GA_IRIX_CC_divisions_entieres' qui est traite par la procedure */ \ /* 'DIVn(...)' qui peut donc, lorsque ce bug est present, demander ici l'impression en */ \ /* format "%x" de valeurs flottantes (puisque evaluees via un 'FLOT(...)' dans 'DIVn(...)'). */ \ /* */ \ /* ATTENTION, on n'ecrit pas : */ \ /* */ \ /* CAL2(Prin11("define %-*s (int)0x%-0*.*x %s%s %-*s %s%s\n" */ \ /* . */ \ /* /|\ */ \ /* | */ \ /* */ \ /* a cause du compactage par '$compacte_SED' qui fait, s'il est utilise, disparaitre */ \ /* l'espace qui figure devant le cast "(int)". D'ou le passage par une chaine intermediaire. */ \ /* */ \ /* La constante 'NCHXMO' (=bDIV(NBITMO,NBITHX)' fut introduite le 20051210175325... */ #Eif ( (! defined(BUG_SYSTEME_C_caster_0x)) \ ) #if ( (defined(SYSTEME_ES9000_AIX_CC)) \ || (defined(SYSTEME_SUN3_SUNOS_CC)) \ || (defined(SYSTEME_SUN4_SUNOS_CC)) \ || (defined(SYSTEME_SUN4NCUBE2S_SUNOS_CC)) \ ) # TestADef BUG_SYSTEME_C_DEFINEX_0x \ /* Le compilateur 'cc' met deja des caracteres "0"... */ #Aif ( (defined(SYSTEME_ES9000_AIX_CC)) \ || (defined(SYSTEME_SUN3_SUNOS_CC)) \ || (defined(SYSTEME_SUN4_SUNOS_CC)) \ || (defined(SYSTEME_SUN4NCUBE2S_SUNOS_CC)) \ ) #Eif ( (defined(SYSTEME_ES9000_AIX_CC)) \ || (defined(SYSTEME_SUN3_SUNOS_CC)) \ || (defined(SYSTEME_SUN4_SUNOS_CC)) \ || (defined(SYSTEME_SUN4NCUBE2S_SUNOS_CC)) \ ) #if ( (defined(BUG_SYSTEME_C_DEFINEX_0x)) \ ) # undef DEFINEX # define DEFINEX(nom,valeur,commentaire) \ Bblock \ DEFV(CHAR,INIC(POINTERc(format_EGAq____DEFINEX) \ ,chain_Aconcaten2(cINTRODUCTION_DES_DIRECTIVES_DU_PREPROCESSEUR_cpp \ ,"define %-*s 0x%-*.*x %s%s %-*s %s%s\n" \ ) \ ) \ ); \ \ CAL2(Prin11(format_EGAq____DEFINEX \ ,__TAB1,nom \ ,bSOU(__TAB2,NEUT(DEUX)),NCHXMO,INTE(valeur) \ ,__SLASH,__STAR \ ,__TAB3,commentaire \ ,__STAR,__SLASH \ ) \ ); \ \ CALZ_FreCC(format_EGAq____DEFINEX); \ Eblock \ /* Definition d'une constante "heXa-decimale". On notera ici l'absence du "0" : */ \ /* */ \ /* CAL2(Prin11("#define %-*s 0x%-0*.*x %s%s %-*s %s%s\n" */ \ /* */ \ /* . */ \ /* /|\ */ \ /* | */ \ /* | */ \ /* */ \ /* car en effet sa presence a pour effet d'en mettre beaucoup plus que necessaire (il */ \ /* semblerait qu'il en ajoute automatiquement lorsque la syntaxe "%-*.*x" est utilisee, */ \ /* et que ceux-ci se cumulent a ceux que l'on demande explicitement par "%-0*.*x"). On */ \ /* notera que l'absence du "0" est apparemment supportee par les autres SYSTEMEs mais */ \ /* comme ils acceptent "0", je prefere le conserver parce qu'il me semble plus logique... */ \ /* */ \ /* ATTENTION, On notera l'introduction recente d'un "cast" 'INTE(valeur)' sur la valeur a */ \ /* editer ; en effet ceci a ete introduit de facon generale, mais lie en fait au bug */ \ /* 'BUG_SYSTEME_SGIND?GA_IRIX_CC_divisions_entieres' qui est traite par la procedure */ \ /* 'DIVn(...)' qui peut donc, lorsque ce bug est present, demander ici l'impression en */ \ /* format "%x" de valeurs flottantes (puisque evaluees via un 'FLOT(...)' dans 'DIVn(...)'). */ \ /* */ \ /* La constante 'NCHXMO' (=bDIV(NBITMO,NBITHX)) fut introduite le 20051210175325... */ #Aif ( (defined(BUG_SYSTEME_C_DEFINEX_0x)) \ ) #Eif ( (defined(BUG_SYSTEME_C_DEFINEX_0x)) \ ) #define DEFINEL(nom,valeur,commentaire) \ Bblock \ DEFINED(nom,valeur,commentaire) \ Eblock \ /* Definition d'une constante "Logique". */ #if (PRECISION_DU_Int==SIMPLE_PRECISION) # define DEFINED(nom,valeur,commentaire) \ Bblock \ DEFV(CHAR,INIC(POINTERc(format_EGAq____DEFINED) \ ,chain_Aconcaten2(cINTRODUCTION_DES_DIRECTIVES_DU_PREPROCESSEUR_cpp \ ,"define %-*s %-*d %s%s %-*s %s%s\n" \ ) \ ) \ ); \ \ CAL2(Prin10(format_EGAq____DEFINED \ ,__TAB1,nom \ ,bSOU(__TAB2,NEUT(ZERO)),INTE(valeur) \ ,__SLASH,__STAR \ ,__TAB3,commentaire \ ,__STAR,__SLASH \ ) \ ); \ \ CALZ_FreCC(format_EGAq____DEFINED); \ Eblock \ /* Definition d'une constante "Decimale". */ \ /* */ \ /* ATTENTION, On notera l'introduction recente d'un "cast" 'INTE(valeur)' sur la valeur a */ \ /* editer ; en effet ceci a ete introduit de facon generale, mais lie en fait au bug */ \ /* 'BUG_SYSTEME_SGIND?GA_IRIX_CC_divisions_entieres' qui est traite par la procedure */ \ /* 'DIVn(...)' qui peut donc, lorsque ce bug est present, demander ici l'impression en */ \ /* format "%x" de valeurs flottantes (puisque evaluees via un 'FLOT(...)' dans 'DIVn(...)'). */ #Aif (PRECISION_DU_Int==SIMPLE_PRECISION) #Eif (PRECISION_DU_Int==SIMPLE_PRECISION) #if (PRECISION_DU_Int==DOUBLE_PRECISION) # define DEFINED(nom,valeur,commentaire) \ Bblock \ DEFV(CHAR,INIC(POINTERc(format_EGAq____DEFINED) \ ,chain_Aconcaten2(cINTRODUCTION_DES_DIRECTIVES_DU_PREPROCESSEUR_cpp \ ,"define %-*s %-*ld %s%s %-*s %s%s\n" \ ) \ ) \ ); \ \ CAL2(Prin10(format_EGAq____DEFINED \ ,__TAB1,nom \ ,bSOU(__TAB2,NEUT(ZERO)),INTE(valeur) \ ,__SLASH,__STAR \ ,__TAB3,commentaire \ ,__STAR,__SLASH \ ) \ ); \ \ CALZ_FreCC(format_EGAq____DEFINED); \ Eblock \ /* Definition d'une constante "Decimale" (introduit sous la forme "%ld" le 20100318185316). */ \ /* La forme "%ld" est redondante avec 'v $xig/fonct$vv$FON 20100322120925', mais je le */ \ /* laisse ainsi, on ne sait jamais... */ #Aif (PRECISION_DU_Int==DOUBLE_PRECISION) #Eif (PRECISION_DU_Int==DOUBLE_PRECISION) #define DEFINEF(nom,valeur,commentaire) \ Bblock \ Test(fiEST_ENTIER(valeur)) \ Bblock \ DEFV(CHAR,INIC(POINTERc(format_EGAq____DEFINEF) \ ,chain_Aconcaten2(cINTRODUCTION_DES_DIRECTIVES_DU_PREPROCESSEUR_cpp \ ,"define %-*s %-*.1f %s%s %-*s %s%s\n" \ ) \ ) \ ); \ \ CAL2(Prin10(format_EGAq____DEFINEF \ ,__TAB1,nom \ ,bSOU(__TAB2,NEUT(ZERO)),valeur \ ,__SLASH,__STAR \ ,__TAB3,commentaire \ ,__STAR,__SLASH \ ) \ ); \ \ CALZ_FreCC(format_EGAq____DEFINEF); \ Eblock \ ATes \ Bblock \ DEFV(CHAR,INIC(POINTERc(format_EGAq_1____DEFINEF) \ ,chain_Aconcaten3("define %-*s %-*" \ ,COND(IL_FAUT(DEFINEF_____compatibilite_20120501) \ ,"g" \ ,".^^^" \ ) \ ," %s%s %-*s %s%s\n" \ ) \ ) \ ); \ DEFV(CHAR,INIC(POINTERc(format_EGAq_2____DEFINEF),CHAINE_UNDEF)); \ \ EGAp(format_EGAq_2____DEFINEF \ ,chain_Aconcaten2(cINTRODUCTION_DES_DIRECTIVES_DU_PREPROCESSEUR_cpp \ ,format_EGAq_1____DEFINEF \ ) \ ); \ \ CAL2(Prin10(format_EGAq_2____DEFINEF \ ,__TAB1,nom \ ,bSOU(__TAB2,NEUT(ZERO)),valeur \ ,__SLASH,__STAR \ ,__TAB3,commentaire \ ,__STAR,__SLASH \ ) \ ); \ \ CALZ_FreCC(format_EGAq_2____DEFINEF); \ CALZ_FreCC(format_EGAq_1____DEFINEF); \ Eblock \ ETes \ Eblock \ /* Definition d'une constante "Flottante" (sans zeros superflus, mais avec le point */ \ /* decimal ou "virgule"...). ATTENTION, l'ecriture : */ \ /* */ \ /* DEFINEF("FDEUXp31",k___FDEUXp31,"deux a la puissance 31."); */ \ /* */ \ /* est fausse car 'DEUXp31M1' est vu alors comme un nombre entier negatif, et la valeur */ \ /* renvoyee est egale a 'DEUXp31M1 - 2'... */ \ /* */ \ /* ATTENTION, lors de l'introduction des deux nouvelles constantes 'F_PETIT_INFINI' et */ \ /* 'F_MOINS_LE_PETIT_INFINI' le 1994102100, j'ai essaye de parentheser la valeur des */ \ /* constantes flottantes afin d'eviter d'eventuelles ambiguites avec les signes. En fait */ \ /* la chose est tres difficile ; par exemple, on ne peut ecrire betement : */ \ /* */ \ /* (%-*.1f) */ \ /* */ \ /* ou encore */ \ /* */ \ /* (%-*g) */ \ /* */ \ /* a cause des tabulations et de la mise en page ; le programme 'v $xtc/printf.01$c' propose */ \ /* une ebauche de solution, via la fonction 'SPrint(...)', mais qui n'est pas entierement */ \ /* satisfaisante car, en effet, la chaine resultat de 'SPrint(...)' doit etre pre-allouee */ \ /* ce qui est tres difficile puisqu'on n'en connait pas la longueur a l'avance (sauf en */ \ /* majorant...). */ \ /* */ \ /* Le 20120501092046, le format "g" a ete remplace par ".^^^" (tout en etant evidemment */ \ /* conserve via 'DEFINEF_____compatibilite_20120501'). Cela fut rendu necessaire avec */ \ /* l'introduction de 'NOMBRE_D_OR' et 'INVERSE_DU_NOMBRE_D_OR' qui se retrouverent avec les */ \ /* valeurs respectives 1.61803 et 0.618034. Cela a un seul "defaut" avec les constantes : */ \ /* */ \ /* F_INFINI 1e+308 1.00000000000000001e+308 */ \ /* F_MOINS_L_INFINI -1e+308 -1.00000000000000001e+308 */ \ /* F_PETIT_INFINI 1e+154 1.00000000000000674e+154 */ \ /* F_MOINS_LE_PETIT_INFINI -1e+154 -1.00000000000000674e+154 */ \ /* */ \ /* qui changent donc legerement de valeurs, d'ou 'v $xcp/Konstantes$K 20120501094724'... */ #define DEFINES(nom,valeur,commentaire) \ Bblock \ DEFV(CHAR,INIC(POINTERc(format_EGAq____DEFINES) \ ,chain_Aconcaten2(cINTRODUCTION_DES_DIRECTIVES_DU_PREPROCESSEUR_cpp \ ,"define %-*s \"%-*s\" %s%s %-*s %s%s\n" \ ) \ ) \ ); \ \ CAL2(Prin10(format_EGAq____DEFINES \ ,__TAB1,nom \ ,bSOU(__TAB2,NEUT(DEUX)),valeur \ ,__SLASH,__STAR \ ,__TAB3,commentaire \ ,__STAR,__SLASH \ ) \ ); \ \ CALZ_FreCC(format_EGAq____DEFINES); \ Eblock \ /* Definition d'une constante "chaine -String- de caracteres". */ #define DEFINEV(nom) \ Bblock \ DEFV(CHAR,INIC(POINTERc(format_EGAq____DEFINEV) \ ,chain_Aconcaten2(cINTRODUCTION_DES_DIRECTIVES_DU_PREPROCESSEUR_cpp \ ,"define %-*s\n" \ ) \ ) \ ); \ \ CAL2(Prin2(format_EGAq____DEFINEV \ ,__TAB1,nom \ ) \ ); \ \ CALZ_FreCC(format_EGAq____DEFINEV); \ Eblock \ /* Definition d'un symbole sans valeur (un "BUG_" par exemple...). */ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* G E S T I O N D U P A R A L L E L I S M E " I N T R A - M A C H I N E " : */ /* */ /* */ /* Utilisation : */ /* */ /* Il est possible de demander */ /* l'execution en parallele d'une */ /* fonction ; il convient alors */ /* de declarer le processus cor- */ /* respondant par : */ /* */ /* DEFV(processus,process_fils); */ /* */ /* puis, de lancer le parallelisme */ /* par : */ /* */ /* iPARALLELE(fonction(arguments),process_fils); */ /* */ /* l'attente eventuelle d'execution */ /* se fera par : */ /* */ /* WAIT(process_fils); */ /* */ /* les echanges entre le pere et le */ /* fils se feront par les huit pri- */ /* mitives suivantes : */ /* */ /* SEND_C(process_fils,message,longueur); */ /* RECEIVE_C(process_fils,message,longueur); */ /* SEND_I(process_fils,valeur_entiere); */ /* RECEIVE_I(process_fils,valeur_entiere); */ /* SEND_F(process_fils,valeur_simple_precision); */ /* RECEIVE_F(process_fils,valeur_simple_precision); */ /* SEND_D(process_fils,valeur_double_precision); */ /* RECEIVE_D(process_fils,valeur_double_precision); */ /* */ /* */ /*************************************************************************************************************************************/ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D E F I N I T I O N D E S P I P E S : */ /* */ /*************************************************************************************************************************************/ #define pipe_fonctions \ INDEX0 \ /* Premiere fonction sur les pipes. */ #define pipe_read \ pipe_fonctions \ /* 'file descriptor' de lecture sur un pipe, */ #define pipe_write \ SUCC(pipe_read) \ /* 'file descriptor' d'ecriture sur un pipe, */ #define pipe_number \ LENG(pipe_read,pipe_write) \ /* Nombre de "file descriptor" sur un pipe. */ Dstruct02(pipe_descriptor ,DEFV(vrai_Int_de_base,etat) /* Etat (pares l'ouverture) du pipe, */ ,DEFV(vrai_Int_de_base,DTb1(fid,pipe_number)) /* Pour memoriser les "files descriptors" de lecture et d'ecriture. */ ,NOM_VIDE ); TypedefP(pipes,STRU(pipe_descriptor)) /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D E F I N I T I O N D ' U N P I P E B I - D I R E C T I O N N E L : */ /* */ /*************************************************************************************************************************************/ Dstruct02(Bi_pipe ,DEFV(pipes,pipe_PvF) /* 'fildes' ("file descriptor") du pipe de dialogue "pere" vers "fils". */ ,DEFV(pipes,pipe_FvP) /* 'fildes' ("file descriptor") du pipe de dialogue "fils" vers "pere". */ ,NOM_VIDE ); TypedefP(bi_pipe,STRU(Bi_pipe)) /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* M E S S A G E S D E S Y N C H R O N I S A T I O N E N T R E P R O C E S S : */ /* */ /*************************************************************************************************************************************/ #define LONG001 \ ZERO #define LONG997 \ LONG001 \ /* ATTENTION : ligne "bidon" destinee a permettre l'insertion de nouveaux */ \ /* messages, auquel cas il est necessaire de decrementer le numero d'une unite... */ #define M_ACK \ "ack" \ /* Message d'accuse de reception d'un 'SEND'. */ #define LONG998 \ MAX2(LONG997,chain_taille(M_ACK)) #define M_DONE \ "done" \ /* Message indiquant a un pere que son fils a termine. */ #define LONG999 \ MAX2(LONG998,chain_taille(M_DONE)) #define LONGUEUR_MESSAGES_PIPE \ LONG999 \ /* Longueur maximale que l'on lira pour se synchroniser. */ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* D E F I N I T I O N D U D E S C R I P T E U R D ' U N P R O C E S S U S " F I L S " : */ /* */ /*************************************************************************************************************************************/ Dstruct04(Processus ,DEFV(vrai_Int_de_base,pid_pere) /* 'pid' ("process identificator") du processus "pere" createur, */ ,DEFV(vrai_Int_de_base,pid_fils) /* 'pid' ("process identificator") du processus "fils" cree. */ ,DEFV(bi_pipe,pipe_I) /* Descripteur du pipe bi-directionnel de dialogue "Information" pere-fils, */ ,DEFV(bi_pipe,pipe_S) /* Descripteur du pipe bi-directionnel de dialogue "Signalisation" pere-fils. */ ,NOM_VIDE ); TypedefP(processus,STRU(Processus)) TypedefS(A___processus,processus) TypedefS(E___processus,processus) #ifdef DECLARATIONS_DES_FONCTIONS_ET_DE_LEURS_ARGUMENTS_VERSION_01 # define ConversionEventuelle_processus(x) \ NEUT(x) \ /* Introduit le 20040619184918... */ #Aifdef DECLARATIONS_DES_FONCTIONS_ET_DE_LEURS_ARGUMENTS_VERSION_01 #Eifdef DECLARATIONS_DES_FONCTIONS_ET_DE_LEURS_ARGUMENTS_VERSION_01 #ifdef DECLARATIONS_DES_FONCTIONS_ET_DE_LEURS_ARGUMENTS_VERSION_02 # define ConversionEventuelle_processus(x) \ ptCAST(processus,x) \ /* Introduit le 20040619184918... */ #Aifdef DECLARATIONS_DES_FONCTIONS_ET_DE_LEURS_ARGUMENTS_VERSION_02 #Eifdef DECLARATIONS_DES_FONCTIONS_ET_DE_LEURS_ARGUMENTS_VERSION_02 #define NoProcess \ ConversionEventuelle_processus(ADRESSE_UNDEF) \ /* Introduit le 20040620092305 principalement pour l'utilisation de la fonction */ \ /* 'v $xiii/contours$FON ARGUMENT_FACULTATIF.ARGUMENT_POINTERs.processus_recepteur..' */ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* P R I M I T I V E S D E P A R A L L E L I S M E : */ /* */ /*************************************************************************************************************************************/ #define iPARALLELE_GENERAL(fonction_pere,fonction_fils,process_fils) \ Bblock \ DEFV(Int,INIT(CodeDErreurSystemeCourant__pipe_I__pipe_PvF,UNDEF)); \ DEFV(Int,INIT(CodeDErreurSystemeCourant__pipe_I__pipe_FvP,UNDEF)); \ DEFV(Int,INIT(CodeDErreurSystemeCourant__pipe_S__pipe_PvF,UNDEF)); \ DEFV(Int,INIT(CodeDErreurSystemeCourant__pipe_S__pipe_FvP,UNDEF)); \ /* Introduits le 20130923110439. Les codes possibles sont les suivants : */ \ /* */ \ /* EFAULT(=14) "Bad address" */ \ /* EMFILE(=24) "Too many open files" */ \ /* */ \ /* ('v /usr/include/asm-generic/errno-base$h'). */ \ \ EGAL(ASD1(PARE(process_fils),pid_pere),Gpid()); \ /* Recuperation de l'identificateur du processus "pere". */ \ /* */ \ /* Il n'y a jamais de retour en erreur avec 'Gpid()'... */ \ EGAL(ASD1(PARE(process_fils),pid_fils),UNDEF); \ /* Et "nettoyage" du fils... */ \ EGAL(ASD3(PARE(process_fils),pipe_I,pipe_PvF,etat) \ ,Pipe(ASD3(PARE(process_fils),pipe_I,pipe_PvF,fid)) \ ); \ EGAL(CodeDErreurSystemeCourant__pipe_I__pipe_PvF,CodeDErreurSystemeCourant); \ /* Ouverture du pipe "Information" "pere" vers "fils". */ \ EGAL(ASD3(PARE(process_fils),pipe_I,pipe_FvP,etat) \ ,Pipe(ASD3(PARE(process_fils),pipe_I,pipe_FvP,fid)) \ ); \ EGAL(CodeDErreurSystemeCourant__pipe_I__pipe_FvP,CodeDErreurSystemeCourant); \ /* Ouverture du pipe "Information" "fils" vers "pere". */ \ EGAL(ASD3(PARE(process_fils),pipe_S,pipe_PvF,etat) \ ,Pipe(ASD3(PARE(process_fils),pipe_S,pipe_PvF,fid)) \ ); \ EGAL(CodeDErreurSystemeCourant__pipe_S__pipe_PvF,CodeDErreurSystemeCourant); \ /* Ouverture du pipe "Signalisation" "pere" vers "fils". */ \ EGAL(ASD3(PARE(process_fils),pipe_S,pipe_FvP,etat) \ ,Pipe(ASD3(PARE(process_fils),pipe_S,pipe_FvP,fid)) \ ); \ EGAL(CodeDErreurSystemeCourant__pipe_S__pipe_FvP,CodeDErreurSystemeCourant); \ /* Ouverture du pipe "Signalisation" "fils" vers "pere". */ \ EGAL(ASD1(PARE(process_fils),pid_fils),Para()); \ /* Creation d'un processus "fils" et memorisation de son identificateur. */ \ /* ATTENTION : le "fils" demarre juste derriere le 'Para', donc */ \ /* ne pas mettre de code commun derriere, d'ailleurs, le 'EGAL' ci-dessus */ \ /* ne fonctionne pas pour le "fils"... */ \ /* */ \ /* En cas de problemes, la valeur -1 est renvoyee par 'Para()'... */ \ \ Test(IFET(IFET(IFET(PAS_DE_PROBLEMES(ASD3(PARE(process_fils),pipe_I,pipe_PvF,etat)) \ ,IFET(IFNE(ITb1(ASD3(PARE(process_fils),pipe_I,pipe_PvF,fid),INDX(pipe_read,pipe_fonctions)) \ ,CANNOT_OPEN \ ) \ ,IFNE(ITb1(ASD3(PARE(process_fils),pipe_I,pipe_PvF,fid),INDX(pipe_write,pipe_fonctions)) \ ,CANNOT_OPEN \ ) \ ) \ ) \ ,IFET(PAS_DE_PROBLEMES(ASD3(PARE(process_fils),pipe_I,pipe_FvP,etat)) \ ,IFET(IFNE(ITb1(ASD3(PARE(process_fils),pipe_I,pipe_FvP,fid),INDX(pipe_read,pipe_fonctions)) \ ,CANNOT_OPEN \ ) \ ,IFNE(ITb1(ASD3(PARE(process_fils),pipe_I,pipe_FvP,fid),INDX(pipe_write,pipe_fonctions)) \ ,CANNOT_OPEN \ ) \ ) \ ) \ ) \ ,IFET(IFET(PAS_DE_PROBLEMES(ASD3(PARE(process_fils),pipe_S,pipe_PvF,etat)) \ ,IFET(IFNE(ITb1(ASD3(PARE(process_fils),pipe_S,pipe_PvF,fid),INDX(pipe_read,pipe_fonctions)) \ ,CANNOT_OPEN \ ) \ ,IFNE(ITb1(ASD3(PARE(process_fils),pipe_S,pipe_PvF,fid),INDX(pipe_write,pipe_fonctions)) \ ,CANNOT_OPEN \ ) \ ) \ ) \ ,IFET(PAS_DE_PROBLEMES(ASD3(PARE(process_fils),pipe_S,pipe_FvP,etat)) \ ,IFET(IFNE(ITb1(ASD3(PARE(process_fils),pipe_S,pipe_FvP,fid),INDX(pipe_read,pipe_fonctions)) \ ,CANNOT_OPEN \ ) \ ,IFNE(ITb1(ASD3(PARE(process_fils),pipe_S,pipe_FvP,fid),INDX(pipe_write,pipe_fonctions)) \ ,CANNOT_OPEN \ ) \ ) \ ) \ ) \ ) \ ) \ Bblock \ Test(PAS_DE_PROBLEMES(ASD1(PARE(process_fils),pid_fils))) \ Bblock \ Test(IFNE(Gpid(),ASD1(PARE(process_fils),pid_pere))) \ Bblock \ /* Lorsqu'on est dans le processus "fils", on lance la fonction "fils" : */ \ BLOC(fonction_fils); \ /* Lorsqu'on est dans le processus "fils", on execute la fonction argument "fils". */ \ Eblock \ ATes \ Bblock \ /* Lorsqu'on est dans le processus "pere", on lance la fonction "pere" : */ \ BLOC(fonction_pere); \ /* Lorsqu'on est dans le processus "pere", on execute la fonction argument "pere". */ \ Eblock \ ETes \ Eblock \ ATes \ Bblock \ PRINT_ERREUR("la creation d'un processus 'fils' n'a pu avoir lieu"); \ CAL1(Prer1("('pid' du fils=%d)\n",ASD1(PARE(process_fils),pid_fils))); \ /* Edition introduite le 20130923110439... */ \ Eblock \ ETes \ Eblock \ ATes \ Bblock \ PRINT_ERREUR("le pipe 'pere-->fils' n'a pu etre cree"); \ CAL1(Prer2("(_process_fils/pipe_I/pipe_PvF/etat=0x%x CodeDErreurSysteme=%d)\n" \ ,ASD3(PARE(process_fils),pipe_I,pipe_PvF,etat) \ ,CodeDErreurSystemeCourant__pipe_I__pipe_PvF \ ) \ ); \ CAL1(Prer2("(_process_fils/pipe_I/pipe_FvP/etat=0x%x CodeDErreurSysteme=%d)\n" \ ,ASD3(PARE(process_fils),pipe_I,pipe_FvP,etat) \ ,CodeDErreurSystemeCourant__pipe_I__pipe_FvP \ ) \ ); \ CAL1(Prer2("(_process_fils/pipe_S/pipe_PvF/etat=0x%x CodeDErreurSysteme=%d)\n" \ ,ASD3(PARE(process_fils),pipe_S,pipe_PvF,etat) \ ,CodeDErreurSystemeCourant__pipe_S__pipe_PvF \ ) \ ); \ CAL1(Prer2("(_process_fils/pipe_S/pipe_FvP/etat=0x%x CodeDErreurSysteme=%d)\n" \ ,ASD3(PARE(process_fils),pipe_S,pipe_FvP,etat) \ ,CodeDErreurSystemeCourant__pipe_S__pipe_FvP \ ) \ ); \ /* Editions introduites le 20130923110439... */ \ /* */ \ /* Le 20131130075621 un "_" a ete introduit devant 'process_fils' dans les 'Prer2(...)'s */ \ /* car, en effet, 'process_fils' est un argument de 'iPARALLELE_GENERAL(...)' et c'est ainsi */ \ /* la seule (?) facon de bloquer la substitution de 'process_fils' dans les 'Prer2(...)'s. */ \ Eblock \ ETes \ Eblock \ /* Generation d'un processus "fils" a partir d'un processus "fils"... */ #define BACKGROUND \ Bblock \ DEFV(processus,process_fils); \ /* Definition des structures utiles au parallelisme... */ \ iPARALLELE_GENERAL(BLOC(Exit(OK); \ /* Puis on tue le processus "pere"... */ \ ) \ ,BLOC(VIDE;) \ /* Le processus "fils" va continuer normalement, en sequence (mais en "background"...). */ \ ,process_fils \ ); \ Eblock \ /* Mise en "background" du programme appelant. Pour ce faire, un processus "fils" est */ \ /* cree qui prend en charge tout le programme (donc en "background"), alors que le processus */ \ /* "pere" est tue tout simplement (ce qui libere donc le "foreground"...). */ #define iPARALLELE(fonction,process_fils) \ Bblock \ iPARALLELE_GENERAL(BLOC(VIDE;) \ /* Le processus "pere" va continuer normalement, en sequence (et en "foreground"...). */ \ ,BLOC(EGAL(ASD1(PARE(process_fils),pid_fils),Gpid()); \ /* Le 'pid' du "fils" est positionne correctement, car en effet */ \ /* lors du 'Para' il ne l'a pas ete... */ \ BLOC(fonction;); \ /* Lorsqu'on est dans le processus "fils", on execute la fonction argument */ \ /* en parallele, puis, on envoie un message "done"... */ \ SEND(process_fils,pipe_S,M_DONE,chain_taille(M_DONE)); \ Exit(OK); \ /* Puis on tue le processus "fils"... */ \ ) \ ,process_fils \ ); \ Eblock \ /* Lancement en parallele de la fonction "fonction" a partir d'un */ \ /* processus "pere". */ #define WAIT(process_fils) \ Bblock \ DEFV(CHAR,INIT(POINTERc(message_de_synchronisation),CHAINE_UNDEF)); \ /* Afin de recevoir le message de synchronisation, malheureusement */ \ /* on ne peut ecrire message[...] car le compilateur refuse l'argument */ \ /* 'LONGUEUR_MESSAGE_PIPES' comme etant trop complique... */ \ EGAL(message_de_synchronisation,kMalo(LONGUEUR_MESSAGES_PIPE)); \ /* Demande d'allocation memoire pour le message de synchronisation. */ \ \ RECEIVE(process_fils,pipe_S,message_de_synchronisation,LONGUEUR_MESSAGES_PIPE); \ \ Test(IFNE_chaine(message_de_synchronisation,M_DONE)) \ Bblock \ PRINT_ERREUR("le processus 'fils' s'est mal termine"); \ CAL1(Prer1("(message de synchronisation='%s')\n",message_de_synchronisation)); \ /* Edition introduite le 20130923110439... */ \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ \ CALZ_FreCC(message_de_synchronisation); \ /* Et on libere l'espace memoire alloue pour le message. */ \ Eblock \ /* Mise d'un "pere" en attente de son "fils". */ #define SEND(process_fils,pipe,message,longueur_du_message) \ Bblock \ Test(IFNE(COND(IFEQ(Gpid(),ASD1(PARE(process_fils),pid_pere)) \ ,Writ(ITb1(ASD3(PARE(process_fils),pipe,pipe_PvF,fid),INDX(pipe_write,pipe_fonctions)) \ ,message \ ,longueur_du_message \ ) \ ,COND(IFEQ(Gpid(),ASD1(PARE(process_fils),pid_fils)) \ ,Writ(ITb1(ASD3(PARE(process_fils),pipe,pipe_FvP,fid),INDX(pipe_write,pipe_fonctions)) \ ,message \ ,longueur_du_message \ ) \ ,UNDEF \ ) \ ) \ ,longueur_du_message \ ) \ ) \ Bblock \ PRINT_ERREUR("probleme d'envoi entre deux processus"); \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ Eblock \ /* Envoi asynchrone d'un message de type "CHAR" entre deux processus. */ #define RECEIVE(process_fils,pipe,message,longueur_du_message) \ Bblock \ Test(IFGT(COND(IFEQ(Gpid(),ASD1(PARE(process_fils),pid_pere)) \ ,Read(ITb1(ASD3(PARE(process_fils),pipe,pipe_FvP,fid),INDX(pipe_read,pipe_fonctions)) \ ,message \ ,longueur_du_message \ ) \ ,COND(IFEQ(Gpid(),ASD1(PARE(process_fils),pid_fils)) \ ,Read(ITb1(ASD3(PARE(process_fils),pipe,pipe_PvF,fid),INDX(pipe_read,pipe_fonctions)) \ ,message \ ,longueur_du_message \ ) \ ,UNDEF \ ) \ ) \ ,longueur_du_message \ ) \ ) \ Bblock \ PRINT_ERREUR("probleme de reception entre deux processus"); \ /* Nota : ce test est en fait inutile, mais mis par symetrie avec 'SEND', */ \ /* en effet, il est legal (avec les messages) de recevoir moins que ce */ \ /* l'on a demande ; en fait, il n'a d'interet que si le "fils" n'existe */ \ /* pas (n'a pas ete cree, ou bien, les primitives de parallelisme */ \ /* sont appelees alors que 'iPARALLELE' ne l'a pas ete...). */ \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ Eblock \ /* Reception asynchrone d'un message de type "CHAR" entre deux processus. */ #define SEND_C(process_fils,message,longueur_du_message) \ Bblock \ DEFV(CHAR,INIT(POINTERc(reponse_d_acquittement),CHAINE_UNDEF)); \ /* Afin de recevoir le message de synchronisation, malheureusement */ \ /* on ne peut ecrire message[...] car le compilateur refuse l'argument */ \ /* 'LONGUEUR_MESSAGE_PIPES' comme etant trop complique... */ \ EGAL(reponse_d_acquittement,kMalo(LONGUEUR_MESSAGES_PIPE)); \ /* Demande d'allocation memoire pour la reponse de synchronisation. */ \ \ SEND(process_fils,pipe_I,message,longueur_du_message) \ RECEIVE(process_fils,pipe_S,reponse_d_acquittement,LONGUEUR_MESSAGES_PIPE); \ \ Test(IFNE_chaine(reponse_d_acquittement,M_ACK)) \ Bblock \ PRINT_ERREUR("l'acquittement d'un 'SEND' est mauvais"); \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ \ CALZ_FreCC(reponse_d_acquittement); \ /* Et on libere l'espace memoire alloue pour la reponse. */ \ Eblock \ /* Envoi synchrone d'un message de type "CHAR" entre deux processus. */ #define RECEIVE_C(process_fils,message,longueur_du_message) \ Bblock \ RECEIVE(process_fils,pipe_I,message,longueur_du_message) \ SEND(process_fils,pipe_S,M_ACK,chain_taille(M_ACK)); \ Eblock \ /* Reception synchrone d'un message de type "CHAR" entre deux processus. */ #define LONGUEUR_SEND_RECEIVE \ LONGUEUR_CHAINE_DOUBLE_MOT \ /* Longueur des echanges en mode "numerique". */ #define SEND_X(process_fils,valeur_numerique,fonction_de_conversion) \ Bblock \ SEND_C(process_fils,fonction_de_conversion(valeur_numerique),LONGUEUR_SEND_RECEIVE); \ Eblock \ /* Envoi synchrone d'un message de type "numerique" entre deux processus. */ #define RECEIVE_X(process_fils,valeur_numerique,fonction_de_conversion) \ Bblock \ DEFV(CHAR,DTb1(message,LONGUEUR_SEND_RECEIVE)); \ /* Buffer de stockage intermediaire du message de type "CHAR". */ \ RECEIVE_C(process_fils,message,LONGUEUR_SEND_RECEIVE); \ EGAL(valeur_numerique,fonction_de_conversion(message)); \ Eblock \ /* Reception synchrone d'un message de type "entier" */ \ /* entre deux processus. */ #define SEND_L(process_fils,valeur_logique) \ Bblock \ SEND_X(process_fils,valeur_logique,Fsortie_logique); \ Eblock \ /* Envoi synchrone d'un message de type "numerique" */ \ /* entre deux processus. */ #define RECEIVE_L(process_fils,valeur_logique) \ Bblock \ RECEIVE_X(process_fils,valeur_logique,Fentree_logique); \ Eblock \ /* Reception synchrone d'un message de type "numerique" */ \ /* entre deux processus. */ #define SEND_I(process_fils,valeur_entiere) \ Bblock \ SEND_X(process_fils,valeur_entiere,Fsortie_entier); \ Eblock \ /* Envoi synchrone d'un message de type "numerique" */ \ /* entre deux processus. */ #define RECEIVE_I(process_fils,valeur_entiere) \ Bblock \ RECEIVE_X(process_fils,valeur_entiere,Fentree_entier); \ Eblock \ /* Reception synchrone d'un message de type "numerique" */ \ /* entre deux processus. */ #define SEND_F(process_fils,valeur_simple_precision) \ Bblock \ SEND_X(process_fils,valeur_simple_precision,Fsortie_simple_precision); \ Eblock \ /* Envoi synchrone d'un message de type "simple-precision" */ \ /* entre deux processus. */ #define RECEIVE_F(process_fils,valeur_simple_precision) \ Bblock \ RECEIVE_X(process_fils,valeur_simple_precision,Fentree_simple_precision); \ Eblock \ /* Reception synchrone d'un message de type "simple-precision" */ \ /* entre deux processus. */ #define SEND_D(process_fils,valeur_double_precision) \ Bblock \ SEND_X(process_fils,valeur_double_precision,Fsortie_double_precision); \ Eblock \ /* Envoi synchrone d'un message de type "double-precision" */ \ /* entre deux processus. */ #define RECEIVE_D(process_fils,valeur_double_precision) \ Bblock \ RECEIVE_X(process_fils,valeur_double_precision,Fentree_double_precision); \ Eblock \ /* Reception synchrone d'un message de type "double-precision" */ \ /* entre deux processus. */ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* G E S T I O N D U P A R A L L E L I S M E " I N T R A - M A C H I N E " : */ /* */ /*************************************************************************************************************************************/ #define iPARALLELE_2(sequence_1,sequence_2,faire_du_parallelisme) \ Bblock \ Test(IL_FAUT(faire_du_parallelisme)) \ Bblock \ DEFV(processus,process_sequence_2); \ /* Definition des structures utiles au parallelisme... */ \ \ iPARALLELE(BLOC(sequence_2),process_sequence_2); \ \ BLOC(sequence_1); \ /* Le processus "sequence 2" va s'executer en parallele du processus "sequence 1". */ \ \ WAIT(process_sequence_2); \ /* Enfin, il faut attendre que les deux sequences soient terminees... */ \ Eblock \ ATes \ Bblock \ BLOC(sequence_1); \ BLOC(sequence_2); \ /* Execution sequentielle des deux sequences. */ \ Eblock \ ETes \ Eblock \ /* Gestion des activites paralleles "intra-machine" a deux sequences. */ #define MULTIPLICITE_DU_PARALLELISME \ DEUX #define NOMBRE_DE_PROCESSUS_PARALLELISABLES_2 \ NEUT(MULTIPLICITE_DU_PARALLELISME) #define NOMBRE_DE_PROCESSUS_PARALLELISABLES_4 \ MUL2(MULTIPLICITE_DU_PARALLELISME,NOMBRE_DE_PROCESSUS_PARALLELISABLES_2) #define NOMBRE_DE_PROCESSUS_PARALLELISABLES_8 \ MUL2(MULTIPLICITE_DU_PARALLELISME,NOMBRE_DE_PROCESSUS_PARALLELISABLES_4) #define TEST_DU_PARALLELISME(faire_du_parallelisme,nombre_de_processus_parallelisables,puissance) \ IFET(IL_FAUT(faire_du_parallelisme) \ ,IFGE(nombre_de_processus_parallelisables \ ,DIVI(nombre_maximal_de_processus_parallelisables,puissance(MULTIPLICITE_DU_PARALLELISME)) \ ) \ ) #define SEQUENCES_PARALLELES_02(sequ_1,sequ_2,faire_du_parallelisme,NdPP) \ /* On notera que 'NdPP' designe 'nombre_de_processus_parallelisables'. Il est utilise a */ \ /* la place de ce dernier afin de reduire la longueur de certaines lignes qui suivent... */ \ Bblock \ DEFV(Positive,INIT(nombre_maximal_de_processus_parallelisables,NOMBRE_DE_PROCESSUS_PARALLELISABLES_2)); \ \ iPARALLELE_2(BLOC(sequ_1) \ ,BLOC(sequ_2) \ ,TEST_DU_PARALLELISME(faire_du_parallelisme,NdPP,EXP0) \ ); \ Eblock \ /* Execution paralelle (si possible) de deux sequences (introduit le 20090414101333). */ #define SEQUENCES_PARALLELES_04(sequ_1,sequ_2,sequ_3,sequ_4,faire_du_parallelisme,NdPP) \ /* On notera que 'NdPP' designe 'nombre_de_processus_parallelisables'. Il est utilise a */ \ /* la place de ce dernier afin de reduire la longueur de certaines lignes qui suivent... */ \ Bblock \ DEFV(Positive,INIT(nombre_maximal_de_processus_parallelisables,NOMBRE_DE_PROCESSUS_PARALLELISABLES_4)); \ /* Introduit le 20090410113429 pour simplifier... */ \ \ iPARALLELE_2(BLOC(iPARALLELE_2(BLOC(sequ_1) \ ,BLOC(sequ_2) \ ,TEST_DU_PARALLELISME(faire_du_parallelisme,NdPP,EXP0) \ ); \ ) \ ,BLOC(iPARALLELE_2(BLOC(sequ_3) \ ,BLOC(sequ_4) \ ,TEST_DU_PARALLELISME(faire_du_parallelisme,NdPP,EXP0) \ ); \ ) \ ,TEST_DU_PARALLELISME(faire_du_parallelisme,NdPP,EXP1) \ ); \ Eblock \ /* Execution paralelle (si possible) de quatre sequences (introduit le 20090407084620). */ \ /* */ \ /* On notera le 20090415132044 que les procedures 'SEQUENCES_PARALLELES_0?(...)' ont perdu */ \ /* beaucoup de leur interet a cette date avec l'extension qui a ete faite de la commande */ \ /* 'v $xcg/parallele.14$K' grace a 'v $xcg/parallele.1N$K'... */ #define SEQUENCES_PARALLELES_08(sequ_1,sequ_2,sequ_3,sequ_4,sequ_5,sequ_6,sequ_7,sequ_8,faire_du_parallelisme,NdPP) \ /* On notera que 'NdPP' designe 'nombre_de_processus_parallelisables'. Il est utilise a */ \ /* la place de ce dernier afin de reduire la longueur de certaines lignes qui suivent... */ \ Bblock \ DEFV(Positive,INIT(nombre_maximal_de_processus_parallelisables,NOMBRE_DE_PROCESSUS_PARALLELISABLES_8)); \ \ iPARALLELE_2(BLOC(iPARALLELE_2(BLOC(iPARALLELE_2(BLOC(sequ_1) \ ,BLOC(sequ_2) \ ,TEST_DU_PARALLELISME(faire_du_parallelisme,NdPP,EXP0) \ ); \ ) \ ,BLOC(iPARALLELE_2(BLOC(sequ_3) \ ,BLOC(sequ_4) \ ,TEST_DU_PARALLELISME(faire_du_parallelisme,NdPP,EXP0) \ ); \ ) \ ,TEST_DU_PARALLELISME(faire_du_parallelisme,NdPP,EXP1) \ ); \ ) \ ,BLOC(iPARALLELE_2(BLOC(iPARALLELE_2(BLOC(sequ_5) \ ,BLOC(sequ_6) \ ,TEST_DU_PARALLELISME(faire_du_parallelisme,NdPP,EXP0) \ ); \ ) \ ,BLOC(iPARALLELE_2(BLOC(sequ_7) \ ,BLOC(sequ_8) \ ,TEST_DU_PARALLELISME(faire_du_parallelisme,NdPP,EXP0) \ ); \ ) \ ,TEST_DU_PARALLELISME(faire_du_parallelisme,NdPP,EXP1) \ ); \ ) \ ,TEST_DU_PARALLELISME(faire_du_parallelisme,NdPP,EXP2) \ ); \ Eblock \ /* Execution paralelle (si possible) de huit sequences (introduit le 20090414101333). */ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* B O U C L E S D ' I T E R A T I O N S P A R A L L E L E S : */ /* */ /*************************************************************************************************************************************/ #define PREMIERE_ITERATION_D_UN_KompParallele \ PREMIERE_ITERATION_D_UN_Komp \ /* Numero de le premiere iteration d'un 'KompParallele(...)'. */ #define UNE_ITERATION_DU_KompParallele(compteur_repetitions_KompP,nombre_repetitions,sequence) \ Bblock \ /* ATTENTION, avant le 20090414095101, il y avait ici : */ \ /* */ \ /* DEFV(Int,INIT(compteur_des_repetitions_du_Komp */ \ /* ,compteur_repetitions_KompP */ \ /* ) */ \ /* ); */ \ /* */ \ /* Cette variable etant definie comme si elle l'avait ete dans un 'Komp(...)' (sequentiel */ \ /* et standard...), mais en fait cela me semblait completement inutile car, en effet, */ \ /* effectivement 'Komp(...)' definit une variable 'compteur_des_repetitions_du_Komp', */ \ /* mais celle-ci est un argument d'appel de 'Komp(...)' et le nom de la variable ainsi */ \ /* definie sera en general different de 'compteur_des_repetitions_du_Komp' (voir a ce */ \ /* propos 'v $xil/defi_K2$vv$DEF compteur_des_repetitions_du_Komp'). Il est donc plus */ \ /* intelligent de la supprimer (ceci avait ete note le 20090410130052). */ \ \ Test(IFLE(compteur_des_repetitions_du_Komp,nombre_repetitions)) \ Bblock \ BLOC(sequence); \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ Eblock #define KompParallele(compteur_repetitions_KompP,nombre_repetitions,faire_parallelisme,nombre_de_processus_parallelisables,sequence) \ /* La procedure 'Komp(...)' parallele a ete introduite le 20090403140841. */ \ Bblock \ DEFV(Int,INIT(compteur_repetitions_KompP,UNDEF)); \ /* Cette variable locale va servir d'indice pour la boucle 'DoIn' qui suit, mais */ \ /* ATTENTION : elle ne peut etre un 'Positive' au cas ou un nombre de repetitions */ \ /* negatif serait communique... */ \ DoIn(compteur_repetitions_KompP \ ,PREMIERE_ITERATION_D_UN_KompParallele \ ,nombre_repetitions \ ,NOMBRE_DE_PROCESSUS_PARALLELISABLES_4 \ ) \ /* ATTENTION : il est impossible d'utiliser ici 'Komp(...)' car, en effet, le pas */ \ /* 'NOMBRE_DE_PROCESSUS_PARALLELISABLES_4' n'est pas egal a 'I'... */ \ Bblock \ SEQUENCES_PARALLELES_04(BLOC(UNE_ITERATION_DU_KompParallele(ADD2(compteur_repetitions_KompP,__ZERO__A__) \ ,nombre_repetitions \ ,BLOC(sequence) \ ) \ ) \ ,BLOC(UNE_ITERATION_DU_KompParallele(ADD2(compteur_repetitions_KompP,__PLUS1__A__) \ ,nombre_repetitions \ ,BLOC(sequence) \ ) \ ) \ ,BLOC(UNE_ITERATION_DU_KompParallele(ADD2(compteur_repetitions_KompP,__PLUS1__A__) \ ,nombre_repetitions \ ,BLOC(sequence) \ ) \ ) \ ,BLOC(UNE_ITERATION_DU_KompParallele(ADD2(compteur_repetitions_KompP,__PLUS1__A__) \ ,nombre_repetitions \ ,BLOC(sequence) \ ) \ ) \ ,faire_parallelisme \ ,nombre_de_processus_parallelisables \ ); \ Eblock \ EDoI \ Eblock \ /* Definition d'un 'Komp(...)' parallele (introduite le 20090403140841). */ /*===================================================================================================================================*/ /*************************************************************************************************************************************/ /* */ /* G E S T I O N D U P A R A L L E L I S M E " E X T R A - M A C H I N E " : */ /* */ /*************************************************************************************************************************************/ #define SEPARATEUR_DES_COMPOSANTES_DES_VERROUS \ C_BLANC \ /* Separateur des composantes du contenu d'un verrou. Ceci fut introduit le 20070425145001. */ \ /* */ \ /* Le 20070627120524, cette definition est passee de 'cSEPARATEUR_DES_PATHS' a 'K_BLANC' */ \ /* plus pratique finalement (pour faire des '$AW' ou des '$SE'...). */ #define POSTFIXE_DES_VERROUS \ GvarDefaut("v",".VERROU") \ /* Postfixe des fichiers de type "verrou". A cause de 'v $xcg/remote.01$K shell' l'option */ \ /* 'GvarDefaut(...)' a ete introduite le 19971021162819. Le 20070417101114 la valeur par */ \ /* defaut ".v" a ete remplace par ".VERROU" (et ce bien tardivement car le modification de */ \ /* '$v' e eu lieu le 'v $xE/.postfixesG$Y 20020917131858'...). */ #define NOMBRE_CHIFFRES_DU_Gpid_DES_VERROUS \ HUIT \ /* Nombre de chiffres utiles a la mises du 'Gpid(...)' dans les verrous. Ceci fut introduit */ \ /* le 20070425145001... */ #define ePARALLELE(sequence_fondamentale,sequence_alternative,faire_du_parallelisme,verrou) \ Bblock \ DEFV(Logical,INIT(executer_la_sequence_fondamentale,VRAI)); \ /* A priori la sequence argument doit etre executee (c'est en particulier le cas evident */ \ /* ou le parallelisme est inhibe...). */ \ \ Test(IL_FAUT(faire_du_parallelisme)) \ Bblock \ DEFV(CHAR,INIT(POINTERc(nom_effectif_du_verrou),chain_Aconcaten2(verrou,POSTFIXE_DES_VERROUS))); \ /* Nom du verrou utilise ; on notera que pour 'ePARALLELE(...)' ait un sens, il est plus */ \ /* que logique que 'verrou' appartienne a un volume 'NFS' (par exemple a '$xw1'). */ \ DEFV(CHAR,INIT(POINTERc(date_AAAAMMJJhhmmss),CHAINE_UNDEF)); \ /* Mise de la date au format "AAAAMMJJhhmmss" introduit le 20070523092319... */ \ DEFV(CHAR,INIT(POINTERc(contenu_du_verrou_sans_C_LF),CHAINE_UNDEF)); \ DEFV(CHAR,INIT(POINTERc(contenu_du_verrou),CHAINE_UNDEF)); \ /* Definition du contenu du verrou. La chaine 'contenu_du_verrou_sans_C_LF' fut introduite */ \ /* le 20070710124212 pour faciliter son edition via 'ePARALLELE_____editer_le_verrou'... */ \ \ MISE_DE_LA_DATE_COURANTE_AU_FORMAT_____AAAAMMJJhhmmss(date_AAAAMMJJhhmmss); \ /* Mise de la date au format "AAAAMMJJhhmmss" introduit le 20070523092319... */ \ \ begin_nouveau_block \ Bblock \ DEFV(CHAR,INIC(POINTERc(format_EGAq____ePARALLELE) \ ,chain_numero(Gpid() \ ,NOMBRE_CHIFFRES_DU_Gpid_DES_VERROUS \ ) \ ) \ ); \ \ EGAp(contenu_du_verrou_sans_C_LF \ ,chain_Aconcaten9(Gvar_sHOTE \ ,SEPARATEUR_DES_COMPOSANTES_DES_VERROUS \ ,Gvar_vCOMPUTERd \ ,SEPARATEUR_DES_COMPOSANTES_DES_VERROUS \ ,Gvar_iHOTE \ ,SEPARATEUR_DES_COMPOSANTES_DES_VERROUS \ ,format_EGAq____ePARALLELE \ ,SEPARATEUR_DES_COMPOSANTES_DES_VERROUS \ ,date_AAAAMMJJhhmmss \ ) \ ); \ \ CALZ_FreCC(format_EGAq____ePARALLELE); \ Eblock \ end_nouveau_block \ \ EGAp(contenu_du_verrou \ ,chain_Aconcaten2(contenu_du_verrou_sans_C_LF \ ,C_LF \ ) \ ); \ /* Contenu (...) du verrou. ATTENTION, il y avait avant : */ \ /* */ \ /* DEFV(CHAR,INIS(DTb0(contenu_du_verrou),Ichaine00)); */ \ /* */ \ /* mais cela ne plaisait pas a 'SYSTEME_NWS3000_NEWSOS_2CC', d'ou la nouvelle version... */ \ /* Puis, j'ai mis : */ \ /* */ \ /* DEFV(Schar,INIS(DTb0(contenu_du_verrou),Ichaine00)); */ \ /* */ \ /* mais il est finalement plus informatif de mettre dans le verrou le nom de la MACHINE */ \ /* qui se l'est approprie (le 1995042400). */ \ /* */ \ /* Le 20070522152159, a cause de 'v $Fdeguise' et 'v $Foptions vCOMPUTER', il a ete decide */ \ /* de mettre '$vCOMPUTERd' et '$iHOTE' dans le verrou afin de lever toute ambiguite... */ \ \ Test(PAS_D_ERREUR(Fstore_non_securise_fichier_non_formatte(contenu_du_verrou \ ,nom_effectif_du_verrou \ ,chain_Xtaille(contenu_du_verrou) \ ,size_CHAR \ ,NE_PAS_EDITER_LES_MESSAGES_D_ERREUR_DES_FICHIERS \ ) \ ) \ ) \ /* ATTENTION, on notera que les fichiers de type "verrou" ne sont jamais detruits */ \ /* automatiquement (car qui pourrait prendre cette responsabilite ?) ; cette destruction */ \ /* est donc faite "a la main" et a l'exterieur... */ \ /* */ \ /* ATTENTION, bien entendu, on n'utilise pas 'EDITER_LES_MESSAGES_D_ERREUR_DES_FICHIERS' */ \ /* puisque le 'Fstore_fichier_non_formatte(...)' est la pour tester la pre-existence du */ \ /* verrou (et le creer dans le cas ou il n'existe pas) ; donc lors d'un fonctionnement */ \ /* parallele veritable, il y aura souvent une erreur "normale" ici... */ \ /* */ \ /* ATTENTION, on notera que pendant longtemps, j'ai utilise : */ \ /* */ \ /* chain_taille(contenu_du_verrou) */ \ /* */ \ /* pour calculer la longueur de la valeur du verrou. Cela faisait donc que le caractere */ \ /* de fin de chaine ('C_VIDE') etait place en fin du verrou, ce qui provoquait un */ \ /* comportement anormal de programmes tel '$GRE' lorsqu'ils recevaient, via un "pipe", des */ \ /* valeurs de verrou. D'ou l'utilisation de 'chain_Xtaille(...)' introduite le 1995051200. */ \ /* */ \ /* Le 20070523102921, la fonction 'Fstore_fichier_non_formatte(...)' a ete remplacee par */ \ /* 'Fstore_non_securise_fichier_non_formatte(...)' afin de supprimer l'operation de */ \ /* renommage que 'Fstore_fichier_non_formatte(...)'. Or nous creeons ici un verrou dont */ \ /* nous testons l'existence ; il faut donc que son nom soit cree directement et non pas */ \ /* via un nom temporaire intermediaire... */ \ Bblock \ /* Cas ou l'on a pu s'appropier le verrou, la sequence sera donc executee ici (en local...). */ \ \ Test(IL_FAUT(ePARALLELE_____editer_le_verrou)) \ Bblock \ CAL3(Prme1("NomVerrou....='%s'\n",nom_effectif_du_verrou)); \ CAL3(Prme1("ContenuVerrou={%s}\n",contenu_du_verrou_sans_C_LF)); \ /* Editions optionnelles introduites le 20070710113932. */ \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ Eblock \ ATes \ Bblock \ EGAL(executer_la_sequence_fondamentale,FAUX); \ /* Cas ou l'on n'a pas pu s'appropier le verrou, la sequence va s'executer ailleurs (ou est */ \ /* deja en train de s'executer ailleurs...), sur la MACHINE qui s'est approprie le verrou... */ \ Eblock \ ETes \ \ CALZ_FreCC(contenu_du_verrou); \ CALZ_FreCC(contenu_du_verrou_sans_C_LF); \ CALZ_FreCC(date_AAAAMMJJhhmmss); \ CALZ_FreCC(nom_effectif_du_verrou); \ /* Liberation des espaces alloues dynamiquement... */ \ Eblock \ ATes \ Bblock \ Eblock \ ETes \ \ Test(IL_FAUT(executer_la_sequence_fondamentale)) \ Bblock \ BLOC(sequence_fondamentale;); \ /* Lorsqu'on est dans les condition d'execution de la sequence dite "fondamentale", on */ \ /* l'execute... */ \ Eblock \ ATes \ Bblock \ BLOC(sequence_alternative;); \ /* Sinon, on ne fait rien (ou presque, puisqu'on execute la sequence dite "alternative"). */ \ Eblock \ ETes \ Eblock \ /* Gestion des activites paralleles "extra-machine". */