File:  [local] / rpl / src / instructions_p4.c
Revision 1.48: download - view: text, annotated - select for diffs - revision graph
Sat Mar 23 16:14:39 2013 UTC (11 years, 1 month ago) by bertrand
Branches: MAIN
CVS tags: HEAD
Correction d'un problème de mutex dans la gestion des variables partagées.
Correction d'un segfault dans les routines de transformation des arbres des
variables en tableau.

    1: /*
    2: ================================================================================
    3:   RPL/2 (R) version 4.1.13
    4:   Copyright (C) 1989-2013 Dr. BERTRAND Joël
    5: 
    6:   This file is part of RPL/2.
    7: 
    8:   RPL/2 is free software; you can redistribute it and/or modify it
    9:   under the terms of the CeCILL V2 License as published by the french
   10:   CEA, CNRS and INRIA.
   11:  
   12:   RPL/2 is distributed in the hope that it will be useful, but WITHOUT
   13:   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
   14:   FITNESS FOR A PARTICULAR PURPOSE.  See the CeCILL V2 License
   15:   for more details.
   16:  
   17:   You should have received a copy of the CeCILL License
   18:   along with RPL/2. If not, write to info@cecill.info.
   19: ================================================================================
   20: */
   21: 
   22: 
   23: #include "rpl-conv.h"
   24: 
   25: 
   26: /*
   27: ================================================================================
   28:   Fonction 'pr1'
   29: ================================================================================
   30:   Entrées :
   31: --------------------------------------------------------------------------------
   32:   Sorties :
   33: --------------------------------------------------------------------------------
   34:   Effets de bord : néant
   35: ================================================================================
   36: */
   37: 
   38: void
   39: instruction_pr1(struct_processus *s_etat_processus)
   40: {
   41:     struct_objet                    *s_objet;
   42: 
   43:     (*s_etat_processus).erreur_execution = d_ex;
   44: 
   45:     if ((*s_etat_processus).affichage_arguments == 'Y')
   46:     {
   47:         printf("\n  PR1 ");
   48: 
   49:         if ((*s_etat_processus).langue == 'F')
   50:         {
   51:             printf("(impression d'un objet)\n\n");
   52:         }
   53:         else
   54:         {
   55:             printf("(print object)\n\n");
   56:         }
   57: 
   58:         printf("    1: %s, %s, %s, %s, %s, %s,\n"
   59:                 "       %s, %s, %s, %s, %s,\n"
   60:                 "       %s, %s, %s, %s, %s,\n"
   61:                 "       %s\n",
   62:                 d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
   63:                 d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
   64:         printf("->  1: %s, %s, %s, %s, %s, %s,\n"
   65:                 "       %s, %s, %s, %s, %s,\n"
   66:                 "       %s, %s, %s, %s, %s,\n"
   67:                 "       %s\n",
   68:                 d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
   69:                 d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
   70: 
   71:         return;
   72:     }
   73:     else if ((*s_etat_processus).test_instruction == 'Y')
   74:     {
   75:         (*s_etat_processus).nombre_arguments = -1;
   76:         return;
   77:     }
   78: 
   79:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
   80:     {
   81:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
   82:         {
   83:             return;
   84:         }
   85:     }
   86: 
   87:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
   88:             &s_objet) == d_erreur)
   89:     {
   90:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
   91:         return;
   92:     }
   93: 
   94:     formateur_tex(s_etat_processus, s_objet, 'N');
   95: 
   96:     /*
   97:      * La fonction pr1 ne modifie pas la pile
   98:      */
   99: 
  100:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  101:             s_objet) == d_erreur)
  102:     {
  103:         return;
  104:     }
  105: 
  106:     return;
  107: }
  108: 
  109: 
  110: /*
  111: ================================================================================
  112:   Fonction 'print'
  113: ================================================================================
  114:   Entrées :
  115: --------------------------------------------------------------------------------
  116:   Sorties :
  117: --------------------------------------------------------------------------------
  118:   Effets de bord : néant
  119: ================================================================================
  120: */
  121: 
  122: void
  123: instruction_print(struct_processus *s_etat_processus)
  124: {
  125:     (*s_etat_processus).erreur_execution = d_ex;
  126: 
  127:     if ((*s_etat_processus).affichage_arguments == 'Y')
  128:     {
  129:         printf("\n  PRINT ");
  130: 
  131:         if ((*s_etat_processus).langue == 'F')
  132:         {
  133:             printf("(impression puis destruction de la file d'impression)"
  134:                     "\n\n");
  135:             printf("  Aucun argument\n");
  136:         }
  137:         else
  138:         {
  139:             printf("(print and purge the printer queue)\n\n");
  140:             printf("  No argument\n");
  141:         }
  142: 
  143:         return;
  144:     }
  145:     else if ((*s_etat_processus).test_instruction == 'Y')
  146:     {
  147:         (*s_etat_processus).nombre_arguments = -1;
  148:         return;
  149:     }
  150: 
  151:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  152:     {
  153:         if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
  154:         {
  155:             return;
  156:         }
  157:     }
  158: 
  159:     if ((*s_etat_processus).nom_fichier_impression == NULL)
  160:     {
  161:         (*s_etat_processus).erreur_execution = d_ex_queue_impression;
  162:         return;
  163:     }
  164: 
  165: #   ifdef POSTSCRIPT_SUPPORT
  166:         impression_tex(s_etat_processus);
  167: #   else
  168:         if ((*s_etat_processus).langue == 'F')
  169:         {
  170:             printf("+++Attention : Support de TeX non compilé !\n");
  171:         }
  172:         else
  173:         {
  174:             printf("+++Warning : TeX not available !\n");
  175:         }
  176: 
  177:         fflush(stdout);
  178: #   endif
  179: 
  180:     return;
  181: }
  182: 
  183: 
  184: /*
  185: ================================================================================
  186:   Fonction 'prst'
  187: ================================================================================
  188:   Entrées :
  189: --------------------------------------------------------------------------------
  190:   Sorties :
  191: --------------------------------------------------------------------------------
  192:   Effets de bord : néant
  193: ================================================================================
  194: */
  195: 
  196: void
  197: instruction_prst(struct_processus *s_etat_processus)
  198: {
  199:     (*s_etat_processus).erreur_execution = d_ex;
  200: 
  201:     if ((*s_etat_processus).affichage_arguments == 'Y')
  202:     {
  203:         printf("\n  PRST ");
  204: 
  205:         if ((*s_etat_processus).langue == 'F')
  206:         {
  207:             printf("(imprime la pile opérationnelle)\n\n");
  208:         }
  209:         else
  210:         {
  211:             printf("(print stack)\n\n");
  212:         }
  213: 
  214:         printf("    n: %s, %s, %s, %s, %s, %s,\n"
  215:                 "       %s, %s, %s, %s, %s,\n"
  216:                 "       %s, %s, %s, %s, %s,\n"
  217:                 "       %s\n",
  218:                 d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
  219:                 d_MIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
  220:         printf("    ...\n");
  221:         printf("    1: %s, %s, %s, %s, %s, %s,\n"
  222:                 "       %s, %s, %s, %s, %s,\n"
  223:                 "       %s, %s, %s, %s, %s,\n"
  224:                 "       %s\n",
  225:                 d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
  226:                 d_MIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
  227:         printf("->  n: %s, %s, %s, %s, %s, %s,\n"
  228:                 "       %s, %s, %s, %s, %s,\n"
  229:                 "       %s, %s, %s, %s, %s,\n"
  230:                 "       %s\n",
  231:                 d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
  232:                 d_MIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
  233:         printf("    ...\n");
  234:         printf("    1: %s, %s, %s, %s, %s, %s,\n"
  235:                 "       %s, %s, %s, %s, %s,\n"
  236:                 "       %s, %s, %s, %s, %s,\n"
  237:                 "       %s\n",
  238:                 d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
  239:                 d_MIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
  240: 
  241:         return;
  242:     }
  243:     else if ((*s_etat_processus).test_instruction == 'Y')
  244:     {
  245:         (*s_etat_processus).nombre_arguments = -1;
  246:         return;
  247:     }
  248: 
  249:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  250:     {
  251:         if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
  252:         {
  253:             return;
  254:         }
  255:     }
  256: 
  257:     routine_recursive = 2;
  258:     impression_pile(s_etat_processus, (*s_etat_processus).l_base_pile,
  259:             'E', 1);
  260:     routine_recursive = 0;
  261:     return;
  262: }
  263: 
  264: 
  265: /*
  266: ================================================================================
  267:   Fonction 'prstc'
  268: ================================================================================
  269:   Entrées :
  270: --------------------------------------------------------------------------------
  271:   Sorties :
  272: --------------------------------------------------------------------------------
  273:   Effets de bord : néant
  274: ================================================================================
  275: */
  276: 
  277: void
  278: instruction_prstc(struct_processus *s_etat_processus)
  279: {
  280:     (*s_etat_processus).erreur_execution = d_ex;
  281: 
  282:     if ((*s_etat_processus).affichage_arguments == 'Y')
  283:     {
  284:         printf("\n  PRSTC ");
  285: 
  286:         if ((*s_etat_processus).langue == 'F')
  287:         {
  288:             printf("(imprime la pile opérationnelle en mode compact)\n\n");
  289:         }
  290:         else
  291:         {
  292:             printf("(print stack in compact mode)\n\n");
  293:         }
  294: 
  295:         printf("    n: %s, %s, %s, %s, %s, %s,\n"
  296:                 "       %s, %s, %s, %s, %s,\n"
  297:                 "       %s, %s, %s, %s, %s,\n"
  298:                 "       %s\n",
  299:                 d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
  300:                 d_MIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
  301:         printf("    ...\n");
  302:         printf("    1: %s, %s, %s, %s, %s, %s,\n"
  303:                 "       %s, %s, %s, %s, %s,\n"
  304:                 "       %s, %s, %s, %s, %s,\n"
  305:                 "       %s\n",
  306:                 d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
  307:                 d_MIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
  308:         printf("->  n: %s, %s, %s, %s, %s, %s,\n"
  309:                 "       %s, %s, %s, %s, %s,\n"
  310:                 "       %s, %s, %s, %s, %s,\n"
  311:                 "       %s\n",
  312:                 d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
  313:                 d_MIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
  314:         printf("    ...\n");
  315:         printf("    1: %s, %s, %s, %s, %s, %s,\n"
  316:                 "       %s, %s, %s, %s, %s,\n"
  317:                 "       %s, %s, %s, %s, %s,\n"
  318:                 "       %s\n",
  319:                 d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
  320:                 d_MIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
  321: 
  322:         return;
  323:     }
  324:     else if ((*s_etat_processus).test_instruction == 'Y')
  325:     {
  326:         (*s_etat_processus).nombre_arguments = -1;
  327:         return;
  328:     }
  329: 
  330:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  331:     {
  332:         if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
  333:         {
  334:             return;
  335:         }
  336:     }
  337: 
  338:     routine_recursive = 2;
  339:     impression_pile(s_etat_processus, (*s_etat_processus).l_base_pile,
  340:             'C', 1);
  341:     routine_recursive = 0;
  342:     return;
  343: }
  344: 
  345: 
  346: /*
  347: ================================================================================
  348:   Fonction 'prvar'
  349: ================================================================================
  350:   Entrées :
  351: --------------------------------------------------------------------------------
  352:   Sorties :
  353: --------------------------------------------------------------------------------
  354:   Effets de bord : néant
  355: ================================================================================
  356: */
  357: 
  358: void
  359: instruction_prvar(struct_processus *s_etat_processus)
  360: {
  361:     struct_objet                    *s_objet;
  362: 
  363:     (*s_etat_processus).erreur_execution = d_ex;
  364: 
  365:     if ((*s_etat_processus).affichage_arguments == 'Y')
  366:     {
  367:         printf("\n  PRVAR ");
  368: 
  369:         if ((*s_etat_processus).langue == 'F')
  370:         {
  371:             printf("(imprime le contenu d'une variable)\n\n");
  372:         }
  373:         else
  374:         {
  375:             printf("(print variable)\n\n");
  376:         }
  377: 
  378:         printf("    1: %s\n", d_NOM);
  379: 
  380:         return;
  381:     }
  382:     else if ((*s_etat_processus).test_instruction == 'Y')
  383:     {
  384:         (*s_etat_processus).nombre_arguments = -1;
  385:         return;
  386:     }
  387: 
  388:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  389:     {
  390:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
  391:         {
  392:             return;
  393:         }
  394:     }
  395: 
  396:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  397:             &s_objet) == d_erreur)
  398:     {
  399:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
  400:         return;
  401:     }
  402: 
  403:     if ((*s_objet).type != NOM)
  404:     {
  405:         liberation(s_etat_processus, s_objet);
  406: 
  407:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
  408:         return;
  409:     }
  410: 
  411:     if (recherche_variable(s_etat_processus, (*((struct_nom *)
  412:             (*s_objet).objet)).nom) == d_faux)
  413:     {
  414:         (*s_etat_processus).erreur_systeme = d_es;
  415:         (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
  416: 
  417:         liberation(s_etat_processus, s_objet);
  418:         return;
  419:     }
  420: 
  421:     if ((*(*s_etat_processus).pointeur_variable_courante).objet != NULL)
  422:     {
  423:         formateur_tex(s_etat_processus, (*(*s_etat_processus)
  424:                 .pointeur_variable_courante).objet, 'N');
  425:     }
  426:     else
  427:     {
  428:         if (recherche_variable_partagee(s_etat_processus,
  429:                 (*(*s_etat_processus).pointeur_variable_courante).nom,
  430:                 (*(*s_etat_processus).pointeur_variable_courante)
  431:                 .variable_partagee, (*(*s_etat_processus)
  432:                 .pointeur_variable_courante).origine) == NULL)
  433:         {
  434:             (*s_etat_processus).erreur_systeme = d_es;
  435:             (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
  436: 
  437:             liberation(s_etat_processus, s_objet);
  438:             return;
  439:         }
  440: 
  441:         formateur_tex(s_etat_processus, (*(*s_etat_processus)
  442:                 .pointeur_variable_partagee_courante).objet, 'N');
  443: 
  444:         if (pthread_mutex_unlock(&((*(*s_etat_processus)
  445:                 .pointeur_variable_partagee_courante).mutex)) != 0)
  446:         {
  447:             (*s_etat_processus).erreur_systeme = d_es_processus;
  448:             return;
  449:         }
  450:     }
  451: 
  452:     liberation(s_etat_processus, s_objet);
  453: 
  454:     return;
  455: }
  456: 
  457: 
  458: /*
  459: ================================================================================
  460:   Fonction 'prusr'
  461: ================================================================================
  462:   Entrées :
  463: --------------------------------------------------------------------------------
  464:   Sorties :
  465: --------------------------------------------------------------------------------
  466:   Effets de bord : néant
  467: ================================================================================
  468: */
  469: 
  470: void
  471: instruction_prusr(struct_processus *s_etat_processus)
  472: {
  473:     integer8                    i;
  474:     integer8                    j;
  475:     integer8                    nb_variables;
  476: 
  477:     struct_objet                s_objet;
  478: 
  479:     struct_tableau_variables    *tableau;
  480: 
  481:     (*s_etat_processus).erreur_execution = d_ex;
  482: 
  483:     if ((*s_etat_processus).affichage_arguments == 'Y')
  484:     {
  485:         printf("\n  PRUSR ");
  486: 
  487:         if ((*s_etat_processus).langue == 'F')
  488:         {
  489:             printf("(impression de toutes les variables utilisateur)\n\n");
  490:             printf("  Aucun argument\n");
  491:         }
  492:         else
  493:         {
  494:             printf("(print all user variables)\n\n");
  495:             printf("  No argument\n");
  496:         }
  497: 
  498:         return;
  499:     }
  500:     else if ((*s_etat_processus).test_instruction == 'Y')
  501:     {
  502:         (*s_etat_processus).nombre_arguments = -1;
  503:         return;
  504:     }
  505: 
  506:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  507:     {
  508:         if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
  509:         {
  510:             return;
  511:         }
  512:     }
  513: 
  514:     if (pthread_mutex_lock(&mutex_liste_variables_partagees) != 0)
  515:     {
  516:         (*s_etat_processus).erreur_systeme = d_es_processus;
  517:         return;
  518:     }
  519: 
  520:     nb_variables = nombre_variables(s_etat_processus);
  521: 
  522:     if ((tableau = malloc(((size_t) nb_variables) *
  523:             sizeof(struct_tableau_variables))) == NULL)
  524:     {
  525:         liberation_mutexes_arbre_variables_partagees(s_etat_processus,
  526:                 (*(*s_etat_processus).s_arbre_variables_partagees));
  527:         pthread_mutex_unlock(&mutex_liste_variables_partagees);
  528:         (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  529:         return;
  530:     }
  531: 
  532:     nb_variables = liste_variables(s_etat_processus, tableau);
  533: 
  534:     if (pthread_mutex_unlock(&mutex_liste_variables_partagees) != 0)
  535:     {
  536:         (*s_etat_processus).erreur_systeme = d_es_processus;
  537:         return;
  538:     }
  539: 
  540:     s_objet.type = CHN;
  541: 
  542:     for(i = 0; i < nb_variables; i++)
  543:     {
  544:         if ((s_objet.objet = malloc((strlen(tableau[i].nom) + 64)
  545:                 * sizeof(unsigned char))) == NULL)
  546:         {
  547:             for(j = i; j < nb_variables; j++)
  548:             {
  549:                 if (tableau[j].mutex != NULL)
  550:                 {
  551:                     pthread_mutex_unlock(tableau[i].mutex);
  552:                 }
  553:             }
  554: 
  555:             free(tableau);
  556: 
  557:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  558:             return;
  559:         }
  560: 
  561:         sprintf((unsigned char *) s_objet.objet, "\\\\noindent %s [%lld]\n",
  562:                 tableau[i].nom, tableau[i].niveau);
  563: 
  564:         if (tableau[i].mutex != NULL)
  565:         {
  566:             pthread_mutex_unlock(tableau[i].mutex);
  567:         }
  568: 
  569:         formateur_tex(s_etat_processus, &s_objet, 'N');
  570:         free(s_objet.objet);
  571:     }
  572: 
  573:     free(tableau);
  574:     return;
  575: }
  576: 
  577: 
  578: /*
  579: ================================================================================
  580:   Fonction 'prmd'
  581: ================================================================================
  582:   Entrées :
  583: --------------------------------------------------------------------------------
  584:   Sorties :
  585: --------------------------------------------------------------------------------
  586:   Effets de bord : néant
  587: ================================================================================
  588: */
  589: 
  590: void
  591: instruction_prmd(struct_processus *s_etat_processus)
  592: {
  593:     long                        i;
  594:     long                        j;
  595:     long                        longueur_utile;
  596:     long                        longueur_utile_limite;
  597: 
  598:     struct_objet                s_objet;
  599: 
  600:     (*s_etat_processus).erreur_execution = d_ex;
  601: 
  602:     if ((*s_etat_processus).affichage_arguments == 'Y')
  603:     {
  604:         printf("\n  PRMD ");
  605: 
  606:         if ((*s_etat_processus).langue == 'F')
  607:         {
  608:             printf("(impression de l'état du séquenceur)\n\n");
  609:             printf("  Aucun argument\n");
  610:         }
  611:         else
  612:         {
  613:             printf("(print sequencer state)\n\n");
  614:             printf("  No argument\n");
  615:         }
  616: 
  617:         return;
  618:     }
  619:     else if ((*s_etat_processus).test_instruction == 'Y')
  620:     {
  621:         (*s_etat_processus).nombre_arguments = -1;
  622:         return;
  623:     }
  624: 
  625:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  626:     {
  627:         if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
  628:         {
  629:             return;
  630:         }
  631:     }
  632: 
  633:     s_objet.type = CHN;
  634: 
  635:     if ((s_objet.objet = malloc(128 * sizeof(unsigned char))) == NULL)
  636:     {
  637:         (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  638:         return;
  639:     }
  640: 
  641:     longueur_utile = 0;
  642:     j = 1;
  643: 
  644:     for(i = 53; i <= 56; i++)
  645:     {
  646:         longueur_utile += (test_cfsf(s_etat_processus, (unsigned char) i)
  647:                 == d_vrai) ? j : 0;
  648:         j *= 2;
  649:     }
  650: 
  651:     longueur_utile_limite = 12;
  652: 
  653:     if (longueur_utile > longueur_utile_limite)
  654:     {
  655:         longueur_utile = longueur_utile_limite;
  656:     }
  657: 
  658:     if ((test_cfsf(s_etat_processus, 49) == d_faux) &&
  659:             (test_cfsf(s_etat_processus, 50) == d_faux))
  660:     {
  661:         if ((*s_etat_processus).langue == 'F')
  662:         {
  663:             sprintf((unsigned char *) s_objet.objet,
  664:                     "\\noindent Mode d'affichage numérique: standard\n");
  665:         }
  666:         else
  667:         {
  668:             sprintf((unsigned char *) s_objet.objet,
  669:                     "\\noindent Numerical mode: standard\n");
  670:         }
  671:     }
  672:     else if ((test_cfsf(s_etat_processus, 49) == d_faux) &&
  673:             (test_cfsf(s_etat_processus, 50) == d_vrai))
  674:     {
  675:         if ((*s_etat_processus).langue == 'F')
  676:         {
  677:             sprintf((unsigned char *) s_objet.objet,
  678:                     "\\noindent Mode d'affichage numérique: "
  679:                     "scientifique (%ld)\n", longueur_utile);
  680:         }
  681:         else
  682:         {
  683:             sprintf((unsigned char *) s_objet.objet,
  684:                     "\\noindent Numerical mode: scientific (%ld)\n",
  685:                     longueur_utile);
  686:         }
  687:     }
  688:     else if ((test_cfsf(s_etat_processus, 49) == d_vrai) &&
  689:             (test_cfsf(s_etat_processus, 50) == d_faux))
  690:     {
  691:         if ((*s_etat_processus).langue == 'F')
  692:         {
  693:             sprintf((unsigned char *) s_objet.objet,
  694:                     "\\noindent Mode d'affichage numérique: "
  695:                     "virgule fixe (%ld)\n", longueur_utile);
  696:         }
  697:         else
  698:         {
  699:             sprintf((unsigned char *) s_objet.objet,
  700:                     "\\noindent Numerical mode: fixed point (%ld)\n", longueur_utile);
  701:         }
  702:     }
  703:     else 
  704:     {
  705:         if ((*s_etat_processus).langue == 'F')
  706:         {
  707:             sprintf((unsigned char *) s_objet.objet,
  708:                     "\\noindent Mode d'affichage numérique: notation ingénieur "
  709:                     "(%ld)\n", longueur_utile);
  710:         }
  711:         else
  712:         {
  713:             sprintf((unsigned char *) s_objet.objet,
  714:                     "\\noindent Numerical mode: engineer "
  715:                     "(%ld)\n", longueur_utile);
  716:         }
  717:     }
  718: 
  719: 
  720:     formateur_tex(s_etat_processus, &s_objet, 'N');
  721:     free(s_objet.objet);
  722: 
  723:     if ((s_objet.objet = malloc(128 * sizeof(unsigned char))) == NULL)
  724:     {
  725:         (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  726:         return;
  727:     }
  728: 
  729:     if ((*s_etat_processus).langue == 'F')
  730:     {
  731:         sprintf((unsigned char *) s_objet.objet,
  732:                 "\\noindent \\'Echelle angulaire: %s\n",
  733:                 (test_cfsf(s_etat_processus, 60) == d_faux)
  734:                 ? "degrés" : "radians");
  735:     }
  736:     else
  737:     {
  738:         sprintf((unsigned char *) s_objet.objet,
  739:                 "\\noindent Angular scale: %s\n",
  740:                 (test_cfsf(s_etat_processus, 60) == d_faux)
  741:                 ? "degrees" : "radians");
  742:     }
  743: 
  744:     formateur_tex(s_etat_processus, &s_objet, 'N');
  745:     free(s_objet.objet);
  746: 
  747:     if ((s_objet.objet = malloc(128 * sizeof(unsigned char))) == NULL)
  748:     {
  749:         (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  750:         return;
  751:     }
  752: 
  753:     if ((test_cfsf(s_etat_processus, 43) == d_faux) &&
  754:             (test_cfsf(s_etat_processus, 44) == d_faux))
  755:     {
  756:         if ((*s_etat_processus).langue == 'F')
  757:         {
  758:             sprintf((unsigned char *) s_objet.objet,
  759:                     "\\noindent Base des entiers : décimale\n");
  760:         }
  761:         else
  762:         {
  763:             sprintf((unsigned char *) s_objet.objet,
  764:                     "\\noindent Integer base: decimal\n");
  765:         }
  766:     }
  767:     else if ((test_cfsf(s_etat_processus, 43) == d_vrai) &&
  768:             (test_cfsf(s_etat_processus, 44) == d_faux))
  769:     {
  770:         if ((*s_etat_processus).langue == 'F')
  771:         {
  772:             sprintf((unsigned char *) s_objet.objet,
  773:                     "\\noindent Base des entiers : octale\n");
  774:         }
  775:         else
  776:         {
  777:             sprintf((unsigned char *) s_objet.objet,
  778:                     "\\noindent Integer base: octal\n");
  779:         }
  780:     }
  781:     else if ((test_cfsf(s_etat_processus, 43) == d_vrai) &&
  782:             (test_cfsf(s_etat_processus, 44) == d_vrai))
  783:     {
  784:         if ((*s_etat_processus).langue == 'F')
  785:         {
  786:             sprintf((unsigned char *) s_objet.objet,
  787:                     "\\noindent Base des entiers : hexadécimale\n");
  788:         }
  789:         else
  790:         {
  791:             sprintf((unsigned char *) s_objet.objet,
  792:                     "\\noindent Integer base: hexadecimal\n");
  793:         }
  794:     }
  795:     else
  796:     {
  797:         if ((*s_etat_processus).langue == 'F')
  798:         {
  799:             sprintf((unsigned char *) s_objet.objet,
  800:                     "\\noindent Base des entiers : binaire\n");
  801:         }
  802:         else
  803:         {
  804:             sprintf((unsigned char *) s_objet.objet,
  805:                     "\\noindent Integer base: binary\n");
  806:         }
  807:     }
  808:     
  809:     formateur_tex(s_etat_processus, &s_objet, 'N');
  810:     free(s_objet.objet);
  811: 
  812:     if ((s_objet.objet = malloc(128 * sizeof(unsigned char))) == NULL)
  813:     {
  814:         (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  815:         return;
  816:     }
  817: 
  818:     if ((*s_etat_processus).langue == 'F')
  819:     {
  820:         sprintf((unsigned char *) s_objet.objet,
  821:                 "\\noindent Longueur des entiers : %d bits\n",
  822:                 longueur_entiers_binaires(s_etat_processus));
  823:     }
  824:     else
  825:     {
  826:         sprintf((unsigned char *) s_objet.objet,
  827:                 "\\noindent Length of integers: %d bits\n",
  828:                 longueur_entiers_binaires(s_etat_processus));
  829:     }
  830: 
  831:     formateur_tex(s_etat_processus, &s_objet, 'N');
  832:     free(s_objet.objet);
  833: 
  834:     if ((s_objet.objet = malloc(128 * sizeof(unsigned char))) == NULL)
  835:     {
  836:         (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  837:         return;
  838:     }
  839: 
  840:     if ((*s_etat_processus).langue == 'F')
  841:     {
  842:         sprintf((unsigned char *) s_objet.objet,
  843:                 "\\noindent Séparateur décimal: %s\n",
  844:                 (test_cfsf(s_etat_processus, 48) == d_faux)
  845:                 ? "point" : "virgule");
  846:     }
  847:     else
  848:     {
  849:         sprintf((unsigned char *) s_objet.objet,
  850:                 "\\noindent Radix: %s\n",
  851:                 (test_cfsf(s_etat_processus, 48) == d_faux)
  852:                 ? "period" : "coma");
  853:     }
  854: 
  855:     formateur_tex(s_etat_processus, &s_objet, 'N');
  856:     free(s_objet.objet);
  857: 
  858:     return;
  859: }
  860: 
  861: 
  862: /*
  863: ================================================================================
  864:   Fonction 'pmin'
  865: ================================================================================
  866:   Entrées :
  867: --------------------------------------------------------------------------------
  868:   Sorties :
  869: --------------------------------------------------------------------------------
  870:   Effets de bord : néant
  871: ================================================================================
  872: */
  873: 
  874: void
  875: instruction_pmin(struct_processus *s_etat_processus)
  876: {
  877:     struct_objet                    *s_objet;
  878: 
  879:     (*s_etat_processus).erreur_execution = d_ex;
  880: 
  881:     if ((*s_etat_processus).affichage_arguments == 'Y')
  882:     {
  883:         printf("\n  PMIN ");
  884: 
  885:         if ((*s_etat_processus).langue == 'F')
  886:         {
  887:             printf("(minima d'un graphique 2D)\n\n");
  888:         }
  889:         else
  890:         {
  891:             printf("(2D-graphic minima)\n\n");
  892:         }
  893: 
  894:         printf("    1: %s\n", d_CPL);
  895: 
  896:         return;
  897:     }
  898:     else if ((*s_etat_processus).test_instruction == 'Y')
  899:     {
  900:         (*s_etat_processus).nombre_arguments = -1;
  901:         return;
  902:     }
  903: 
  904:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  905:     {
  906:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
  907:         {
  908:             return;
  909:         }
  910:     }
  911: 
  912:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  913:             &s_objet) == d_erreur)
  914:     {
  915:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
  916:         return;
  917:     }
  918: 
  919:     if ((*s_objet).type == CPL)
  920:     {
  921:         if ((*s_etat_processus).systeme_axes == 0)
  922:         {
  923:             (*s_etat_processus).x_min = (*((complex16 *) (*s_objet).objet))
  924:                     .partie_reelle;
  925:             (*s_etat_processus).y_min = (*((complex16 *) (*s_objet).objet))
  926:                     .partie_imaginaire;
  927:         }
  928:         else
  929:         {
  930:             (*s_etat_processus).x2_min = (*((complex16 *) (*s_objet).objet))
  931:                     .partie_reelle;
  932:             (*s_etat_processus).y2_min = (*((complex16 *) (*s_objet).objet))
  933:                     .partie_imaginaire;
  934:         }
  935:     }
  936:     else
  937:     {
  938:         liberation(s_etat_processus, s_objet);
  939: 
  940:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
  941:         return;
  942:     }
  943: 
  944:     liberation(s_etat_processus, s_objet);
  945: 
  946:     if (test_cfsf(s_etat_processus, 52) == d_faux)
  947:     {
  948:         if ((*s_etat_processus).fichiers_graphiques != NULL)
  949:         {
  950:             appel_gnuplot(s_etat_processus, 'N');
  951:         }
  952:     }
  953: 
  954:     return;
  955: }
  956: 
  957: 
  958: /*
  959: ================================================================================
  960:   Fonction 'pmax'
  961: ================================================================================
  962:   Entrées :
  963: --------------------------------------------------------------------------------
  964:   Sorties :
  965: --------------------------------------------------------------------------------
  966:   Effets de bord : néant
  967: ================================================================================
  968: */
  969: 
  970: void
  971: instruction_pmax(struct_processus *s_etat_processus)
  972: {
  973:     struct_objet                    *s_objet;
  974: 
  975:     (*s_etat_processus).erreur_execution = d_ex;
  976: 
  977:     if ((*s_etat_processus).affichage_arguments == 'Y')
  978:     {
  979:         printf("\n  PMAX ");
  980: 
  981:         if ((*s_etat_processus).langue == 'F')
  982:         {
  983:             printf("(maxima d'un graphique 2D)\n\n");
  984:         }
  985:         else
  986:         {
  987:             printf("(2D-graphic maxima)\n\n");
  988:         }
  989: 
  990:         printf("    1: %s\n", d_CPL);
  991: 
  992:         return;
  993:     }
  994:     else if ((*s_etat_processus).test_instruction == 'Y')
  995:     {
  996:         (*s_etat_processus).nombre_arguments = -1;
  997:         return;
  998:     }
  999: 
 1000:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1001:     {
 1002:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 1003:         {
 1004:             return;
 1005:         }
 1006:     }
 1007: 
 1008:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1009:             &s_objet) == d_erreur)
 1010:     {
 1011:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1012:         return;
 1013:     }
 1014: 
 1015:     if ((*s_objet).type == CPL)
 1016:     {
 1017:         if ((*s_etat_processus).systeme_axes == 0)
 1018:         {
 1019:             (*s_etat_processus).x_max = (*((complex16 *) (*s_objet).objet))
 1020:                     .partie_reelle;
 1021:             (*s_etat_processus).y_max = (*((complex16 *) (*s_objet).objet))
 1022:                     .partie_imaginaire;
 1023:         }
 1024:         else
 1025:         {
 1026:             (*s_etat_processus).x2_max = (*((complex16 *) (*s_objet).objet))
 1027:                     .partie_reelle;
 1028:             (*s_etat_processus).y2_max = (*((complex16 *) (*s_objet).objet))
 1029:                     .partie_imaginaire;
 1030:         }
 1031:     }
 1032:     else
 1033:     {
 1034:         liberation(s_etat_processus, s_objet);
 1035: 
 1036:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 1037:         return;
 1038:     }
 1039: 
 1040:     liberation(s_etat_processus, s_objet);
 1041: 
 1042:     if (test_cfsf(s_etat_processus, 52) == d_faux)
 1043:     {
 1044:         if ((*s_etat_processus).fichiers_graphiques != NULL)
 1045:         {
 1046:             appel_gnuplot(s_etat_processus, 'N');
 1047:         }
 1048:     }
 1049: 
 1050:     return;
 1051: }
 1052: 
 1053: 
 1054: /*
 1055: ================================================================================
 1056:   Fonction 'persist'
 1057: ================================================================================
 1058:   Entrées :
 1059: --------------------------------------------------------------------------------
 1060:   Sorties :
 1061: --------------------------------------------------------------------------------
 1062:   Effets de bord : néant
 1063: ================================================================================
 1064: */
 1065: 
 1066: void
 1067: instruction_persist(struct_processus *s_etat_processus)
 1068: {
 1069:     (*s_etat_processus).erreur_execution = d_ex;
 1070: 
 1071:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1072:     {
 1073:         printf("\n  PERSIST ");
 1074: 
 1075:         if ((*s_etat_processus).langue == 'F')
 1076:         {
 1077:             printf("(détachement d'un graphique)\n\n");
 1078:             printf("  Aucun argument\n");
 1079:         }
 1080:         else
 1081:         {
 1082:             printf("(spawn a graphic output)\n\n");
 1083:             printf("  No argument\n");
 1084:         }
 1085: 
 1086:         return;
 1087:     }
 1088:     else if ((*s_etat_processus).test_instruction == 'Y')
 1089:     {
 1090:         (*s_etat_processus).nombre_arguments = -1;
 1091:         return;
 1092:     }
 1093: 
 1094:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1095:     {
 1096:         if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
 1097:         {
 1098:             return;
 1099:         }
 1100:     }
 1101: 
 1102:     appel_gnuplot(s_etat_processus, 'E');
 1103: 
 1104:     return;
 1105: }
 1106: 
 1107: 
 1108: /*
 1109: ================================================================================
 1110:   Fonction 'polar' (passe en mode d'affichage r=f(t))
 1111: ================================================================================
 1112:   Entrées : structure processus
 1113: --------------------------------------------------------------------------------
 1114:   Sorties :
 1115: --------------------------------------------------------------------------------
 1116:   Effets de bord : néant
 1117: ================================================================================
 1118: */
 1119: 
 1120: void
 1121: instruction_polar(struct_processus *s_etat_processus)
 1122: {
 1123:     (*s_etat_processus).erreur_execution = d_ex;
 1124: 
 1125:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1126:     {
 1127:         printf("\n  POLAR ");
 1128: 
 1129:         if ((*s_etat_processus).langue == 'F')
 1130:         {
 1131:             printf("(tracé théta=f(r))\n\n");
 1132:             printf("  Aucun argument\n");
 1133:         }
 1134:         else
 1135:         {
 1136:             printf("(plot theta=f(r))\n\n");
 1137:             printf("  No argument\n");
 1138:         }
 1139: 
 1140:         return;
 1141:     }
 1142:     else if ((*s_etat_processus).test_instruction == 'Y')
 1143:     {
 1144:         (*s_etat_processus).nombre_arguments = -1;
 1145:         return;
 1146:     }
 1147:     
 1148:     strcpy((*s_etat_processus).type_trace_eq, "POLAIRE");
 1149: 
 1150:     return;
 1151: }
 1152: 
 1153: 
 1154: /*
 1155: ================================================================================
 1156:   Fonction 'parametric' (passe en mode d'affichage r=f(t))
 1157: ================================================================================
 1158:   Entrées : structure processus
 1159: --------------------------------------------------------------------------------
 1160:   Sorties :
 1161: --------------------------------------------------------------------------------
 1162:   Effets de bord : néant
 1163: ================================================================================
 1164: */
 1165: 
 1166: void
 1167: instruction_parametric(struct_processus *s_etat_processus)
 1168: {
 1169:     (*s_etat_processus).erreur_execution = d_ex;
 1170: 
 1171:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1172:     {
 1173:         printf("\n  PARAMETRIC ");
 1174: 
 1175:         if ((*s_etat_processus).langue == 'F')
 1176:         {
 1177:             printf("(tracé (x,y)=f(t)+i*g(t))\n\n");
 1178:             printf("  Aucun argument\n");
 1179:         }
 1180:         else
 1181:         {
 1182:             printf("(plot (x,y)=f(t)+i*g(t))\n\n");
 1183:             printf("  No argument\n");
 1184:         }
 1185: 
 1186:         return;
 1187:     }
 1188:     else if ((*s_etat_processus).test_instruction == 'Y')
 1189:     {
 1190:         (*s_etat_processus).nombre_arguments = -1;
 1191:         return;
 1192:     }
 1193:     
 1194:     strcpy((*s_etat_processus).type_trace_eq, "PARAMETRIQUE");
 1195: 
 1196:     return;
 1197: }
 1198: 
 1199: 
 1200: /*
 1201: ================================================================================
 1202:   Fonction 'perm'
 1203: ================================================================================
 1204:   Entrées :
 1205: --------------------------------------------------------------------------------
 1206:   Sorties :
 1207: --------------------------------------------------------------------------------
 1208:   Effets de bord : néant
 1209: ================================================================================
 1210: */
 1211: 
 1212: void
 1213: instruction_perm(struct_processus *s_etat_processus)
 1214: {
 1215:     integer8                        k;
 1216:     integer8                        n;
 1217:     integer8                        cint_max;
 1218: 
 1219:     real8                           c;
 1220: 
 1221:     struct_objet                    *s_objet_argument_1;
 1222:     struct_objet                    *s_objet_argument_2;
 1223:     struct_objet                    *s_objet_resultat;
 1224: 
 1225:     unsigned long                   i;
 1226: 
 1227:     (*s_etat_processus).erreur_execution = d_ex;
 1228: 
 1229:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1230:     {
 1231:         printf("\n  PERM ");
 1232: 
 1233:         if ((*s_etat_processus).langue == 'F')
 1234:         {
 1235:             printf("(permutation)\n\n");
 1236:         }
 1237:         else
 1238:         {
 1239:             printf("(permutation)\n\n");
 1240:         }
 1241: 
 1242:         printf("    2: %s\n", d_INT);
 1243:         printf("    1: %s\n", d_INT);
 1244:         printf("->  1: %s, %s\n", d_INT, d_REL);
 1245: 
 1246:         return;
 1247:     }
 1248:     else if ((*s_etat_processus).test_instruction == 'Y')
 1249:     {
 1250:         (*s_etat_processus).nombre_arguments = 2;
 1251:         return;
 1252:     }
 1253:     
 1254:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1255:     {
 1256:         if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
 1257:         {
 1258:             return;
 1259:         }
 1260:     }
 1261: 
 1262:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1263:             &s_objet_argument_1) == d_erreur)
 1264:     {
 1265:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1266:         return;
 1267:     }
 1268: 
 1269:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1270:             &s_objet_argument_2) == d_erreur)
 1271:     {
 1272:         liberation(s_etat_processus, s_objet_argument_1);
 1273: 
 1274:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1275:         return;
 1276:     }
 1277: 
 1278:     if (((*s_objet_argument_1).type == INT) &&
 1279:             ((*s_objet_argument_2).type == INT))
 1280:     {
 1281:         n = (*((integer8 *) (*s_objet_argument_2).objet));
 1282:         k = (*((integer8 *) (*s_objet_argument_1).objet));
 1283: 
 1284:         if ((n < 0) || (k < 0) || (k > n))
 1285:         {
 1286:             liberation(s_etat_processus, s_objet_argument_1);
 1287:             liberation(s_etat_processus, s_objet_argument_2);
 1288: 
 1289:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
 1290:             return;
 1291:         }
 1292: 
 1293:         f90arrangement(&n, &k, &c);
 1294: 
 1295:         for(i = 1, cint_max = 1; i < (8 * sizeof(integer8)) - 1; cint_max =
 1296:                 (cint_max << 1) + 1, i++);
 1297: 
 1298:         if (c > cint_max)
 1299:         {
 1300:             if ((s_objet_resultat = allocation(s_etat_processus, REL))
 1301:                     == NULL)
 1302:             {
 1303:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1304:                 return;
 1305:             }
 1306: 
 1307:             (*((real8 *) (*s_objet_resultat).objet)) = c;
 1308:         }
 1309:         else
 1310:         {
 1311:             if ((s_objet_resultat = allocation(s_etat_processus, INT))
 1312:                     == NULL)
 1313:             {
 1314:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1315:                 return;
 1316:             }
 1317: 
 1318:             if (abs(c - floor(c)) < fabs(ceil(c) - c))
 1319:             {
 1320:                 (*((integer8 *) (*s_objet_resultat).objet)) =
 1321:                         (integer8) floor(c);
 1322:             } 
 1323:             else
 1324:             {
 1325:                 (*((integer8 *) (*s_objet_resultat).objet)) =
 1326:                         1 + (integer8) floor(c);
 1327:             } 
 1328:         }
 1329:     }
 1330:     else
 1331:     {
 1332:         liberation(s_etat_processus, s_objet_argument_1);
 1333:         liberation(s_etat_processus, s_objet_argument_2);
 1334: 
 1335:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 1336:         return;
 1337:     }
 1338: 
 1339:     liberation(s_etat_processus, s_objet_argument_1);
 1340:     liberation(s_etat_processus, s_objet_argument_2);
 1341: 
 1342:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1343:             s_objet_resultat) == d_erreur)
 1344:     {
 1345:         return;
 1346:     }
 1347: 
 1348:     return;
 1349: }
 1350: 
 1351: 
 1352: /*
 1353: ================================================================================
 1354:   Fonction 'psdev'
 1355: ================================================================================
 1356:   Entrées :
 1357: --------------------------------------------------------------------------------
 1358:   Sorties :
 1359: --------------------------------------------------------------------------------
 1360:   Effets de bord : néant
 1361: ================================================================================
 1362: */
 1363: 
 1364: void
 1365: instruction_psdev(struct_processus *s_etat_processus)
 1366: {
 1367:     struct_objet                        *s_objet_statistique;
 1368:     struct_objet                        *s_objet_resultat;
 1369:     struct_objet                        *s_objet_temporaire;
 1370: 
 1371:     integer8                            nombre_colonnes;
 1372: 
 1373:     (*s_etat_processus).erreur_execution = d_ex;
 1374: 
 1375:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1376:     {
 1377:         printf("\n  PSDEV ");
 1378: 
 1379:         if ((*s_etat_processus).langue == 'F')
 1380:         {
 1381:             printf("(écart-type d'une population)\n\n");
 1382:         }
 1383:         else
 1384:         {
 1385:             printf("(population standard deviation)\n\n");
 1386:         }
 1387: 
 1388:         printf("->  1: %s, %s, %s, %s\n", d_INT, d_REL, d_VIN, d_VRL);
 1389: 
 1390:         return;
 1391:     }
 1392:     else if ((*s_etat_processus).test_instruction == 'Y')
 1393:     {
 1394:         (*s_etat_processus).nombre_arguments = -1;
 1395:         return;
 1396:     }
 1397: 
 1398:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1399:     {
 1400:         if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
 1401:         {
 1402:             return;
 1403:         }
 1404:     }
 1405: 
 1406:     /*
 1407:      * Recherche d'une variable globale référencée par SIGMA
 1408:      */
 1409: 
 1410:     if (recherche_variable_globale(s_etat_processus, ds_sdat) == d_faux)
 1411:     {
 1412:         /*
 1413:          * Aucune variable SIGMA
 1414:          */
 1415: 
 1416:         (*s_etat_processus).erreur_systeme = d_es;
 1417: 
 1418:         if ((*s_etat_processus).erreur_execution == d_ex)
 1419:         {
 1420:             (*s_etat_processus).erreur_execution = d_ex_absence_observations;
 1421:         }
 1422: 
 1423:         return;
 1424:     }
 1425:     else
 1426:     {
 1427:         if (((*(*(*s_etat_processus).pointeur_variable_courante).objet)
 1428:                 .type != MIN) && ((*(*(*s_etat_processus)
 1429:                 .pointeur_variable_courante).objet).type != MRL))
 1430:         {
 1431:             (*s_etat_processus).erreur_execution =
 1432:                     d_ex_matrice_statistique_invalide;
 1433:             return;
 1434:         }
 1435: 
 1436:         nombre_colonnes = (*((struct_matrice *) (*(*(*s_etat_processus)
 1437:                 .pointeur_variable_courante).objet).objet)).nombre_colonnes;
 1438:     }
 1439: 
 1440:     s_objet_statistique = (*(*s_etat_processus).pointeur_variable_courante)
 1441:             .objet;
 1442: 
 1443:     if (((*s_objet_statistique).type == MIN) ||
 1444:             ((*s_objet_statistique).type == MRL))
 1445:     {
 1446:         if ((s_objet_resultat = allocation(s_etat_processus, NON)) == NULL)
 1447:         {
 1448:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1449:             return;
 1450:         }
 1451: 
 1452:         if (((*s_objet_resultat).objet = ecart_type_statistique(
 1453:                 (struct_matrice *) (*s_objet_statistique).objet, 'P')) == NULL)
 1454:         {
 1455:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1456:             return;
 1457:         }
 1458: 
 1459:         if (nombre_colonnes == 1)
 1460:         {
 1461:             if ((*((struct_vecteur *) (*s_objet_resultat).objet)).type == 'I')
 1462:             {
 1463:                 (*s_objet_resultat).type = VIN;
 1464:                 s_objet_temporaire = s_objet_resultat;
 1465: 
 1466:                 if ((s_objet_resultat = allocation(s_etat_processus, INT))
 1467:                         == NULL)
 1468:                 {
 1469:                     (*s_etat_processus).erreur_systeme =
 1470:                             d_es_allocation_memoire;
 1471:                     return;
 1472:                 }
 1473: 
 1474:                 (*((integer8 *) (*s_objet_resultat).objet)) =
 1475:                         ((integer8 *) (*((struct_vecteur *)
 1476:                         (*s_objet_temporaire).objet)).tableau)[0];
 1477: 
 1478:                 liberation(s_etat_processus, s_objet_temporaire);
 1479:             }
 1480:             else
 1481:             {
 1482:                 (*s_objet_resultat).type = VRL;
 1483:                 s_objet_temporaire = s_objet_resultat;
 1484: 
 1485:                 if ((s_objet_resultat = allocation(s_etat_processus, REL))
 1486:                         == NULL)
 1487:                 {
 1488:                     (*s_etat_processus).erreur_systeme =
 1489:                             d_es_allocation_memoire;
 1490:                     return;
 1491:                 }
 1492: 
 1493:                 (*((real8 *) (*s_objet_resultat).objet)) =
 1494:                         ((real8 *) (*((struct_vecteur *)
 1495:                         (*s_objet_temporaire).objet)).tableau)[0];
 1496: 
 1497:                 liberation(s_etat_processus, s_objet_temporaire);
 1498:             }
 1499:         }
 1500:         else
 1501:         {
 1502:             if ((*((struct_vecteur *) (*s_objet_resultat).objet)).type == 'I')
 1503:             {
 1504:                 (*s_objet_resultat).type = VIN;
 1505:             }
 1506:             else
 1507:             {
 1508:                 (*s_objet_resultat).type = VRL;
 1509:             }
 1510:         }
 1511: 
 1512:         if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1513:                 s_objet_resultat) == d_erreur)
 1514:         {
 1515:             return;
 1516:         }
 1517:     }
 1518:     else
 1519:     {
 1520:         (*s_etat_processus).erreur_execution =
 1521:                 d_ex_matrice_statistique_invalide;
 1522:         return;
 1523:     }
 1524: 
 1525:     return;
 1526: }
 1527: 
 1528: 
 1529: /*
 1530: ================================================================================
 1531:   Fonction 'pvar'
 1532: ================================================================================
 1533:   Entrées :
 1534: --------------------------------------------------------------------------------
 1535:   Sorties :
 1536: --------------------------------------------------------------------------------
 1537:   Effets de bord : néant
 1538: ================================================================================
 1539: */
 1540: 
 1541: void
 1542: instruction_pvar(struct_processus *s_etat_processus)
 1543: {
 1544:     struct_objet                        *s_objet_statistique;
 1545:     struct_objet                        *s_objet_resultat;
 1546:     struct_objet                        *s_objet_temporaire;
 1547: 
 1548:     integer8                            nombre_colonnes;
 1549: 
 1550:     (*s_etat_processus).erreur_execution = d_ex;
 1551: 
 1552:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1553:     {
 1554:         printf("\n  PVAR ");
 1555: 
 1556:         if ((*s_etat_processus).langue == 'F')
 1557:         {
 1558:             printf("(variance d'une population)\n\n");
 1559:         }
 1560:         else
 1561:         {
 1562:             printf("(population variance)\n\n");
 1563:         }
 1564: 
 1565:         printf("->  1: %s, %s, %s, %s\n", d_INT, d_REL, d_VIN, d_VRL);
 1566: 
 1567:         return;
 1568:     }
 1569:     else if ((*s_etat_processus).test_instruction == 'Y')
 1570:     {
 1571:         (*s_etat_processus).nombre_arguments = -1;
 1572:         return;
 1573:     }
 1574: 
 1575:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1576:     {
 1577:         if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
 1578:         {
 1579:             return;
 1580:         }
 1581:     }
 1582: 
 1583:     /*
 1584:      * Recherche d'une variable globale référencée par SIGMA
 1585:      */
 1586: 
 1587:     if (recherche_variable_globale(s_etat_processus, ds_sdat) == d_faux)
 1588:     {
 1589:         /*
 1590:          * Aucune variable SIGMA
 1591:          */
 1592: 
 1593:         (*s_etat_processus).erreur_systeme = d_es;
 1594: 
 1595:         if ((*s_etat_processus).erreur_execution == d_ex)
 1596:         {
 1597:             (*s_etat_processus).erreur_execution = d_ex_absence_observations;
 1598:         }
 1599: 
 1600:         return;
 1601:     }
 1602:     else
 1603:     {
 1604:         if (((*(*(*s_etat_processus).pointeur_variable_courante).objet)
 1605:                 .type != MIN) && ((*(*(*s_etat_processus)
 1606:                 .pointeur_variable_courante).objet).type != MRL))
 1607:         {
 1608:             (*s_etat_processus).erreur_execution =
 1609:                     d_ex_matrice_statistique_invalide;
 1610:             return;
 1611:         }
 1612: 
 1613:         nombre_colonnes = (*((struct_matrice *) (*(*(*s_etat_processus)
 1614:                 .pointeur_variable_courante).objet).objet)).nombre_colonnes;
 1615:     }
 1616: 
 1617:     s_objet_statistique = (*(*s_etat_processus).pointeur_variable_courante)
 1618:             .objet;
 1619: 
 1620:     if (((*s_objet_statistique).type == MIN) ||
 1621:             ((*s_objet_statistique).type == MRL))
 1622:     {
 1623:         if ((s_objet_resultat = allocation(s_etat_processus, NON))
 1624:                 == NULL)
 1625:         {
 1626:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1627:             return;
 1628:         }
 1629: 
 1630:         if (((*s_objet_resultat).objet = variance_statistique((struct_matrice *)
 1631:                 (*s_objet_statistique).objet, 'P')) == NULL)
 1632:         {
 1633:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1634:             return;
 1635:         }
 1636: 
 1637:         if (nombre_colonnes == 1)
 1638:         {
 1639:             if ((*((struct_vecteur *) (*s_objet_resultat).objet)).type == 'I')
 1640:             {
 1641:                 (*s_objet_resultat).type = VIN;
 1642:                 s_objet_temporaire = s_objet_resultat;
 1643: 
 1644:                 if ((s_objet_resultat = allocation(s_etat_processus, INT))
 1645:                         == NULL)
 1646:                 {
 1647:                     (*s_etat_processus).erreur_systeme =
 1648:                             d_es_allocation_memoire;
 1649:                     return;
 1650:                 }
 1651: 
 1652:                 (*((integer8 *) (*s_objet_resultat).objet)) =
 1653:                         ((integer8 *) (*((struct_vecteur *)
 1654:                         (*s_objet_temporaire).objet)).tableau)[0];
 1655: 
 1656:                 liberation(s_etat_processus, s_objet_temporaire);
 1657:             }
 1658:             else
 1659:             {
 1660:                 (*s_objet_resultat).type = VRL;
 1661:                 s_objet_temporaire = s_objet_resultat;
 1662: 
 1663:                 if ((s_objet_resultat = allocation(s_etat_processus, REL))
 1664:                         == NULL)
 1665:                 {
 1666:                     (*s_etat_processus).erreur_systeme =
 1667:                             d_es_allocation_memoire;
 1668:                     return;
 1669:                 }
 1670: 
 1671:                 (*((real8 *) (*s_objet_resultat).objet)) =
 1672:                         ((real8 *) (*((struct_vecteur *)
 1673:                         (*s_objet_temporaire).objet)).tableau)[0];
 1674: 
 1675:                 liberation(s_etat_processus, s_objet_temporaire);
 1676:             }
 1677:         }
 1678:         else
 1679:         {
 1680:             if ((*((struct_vecteur *) (*s_objet_resultat).objet)).type == 'I')
 1681:             {
 1682:                 (*s_objet_resultat).type = VIN;
 1683:             }
 1684:             else
 1685:             {
 1686:                 (*s_objet_resultat).type = VRL;
 1687:             }
 1688:         }
 1689: 
 1690:         if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1691:                 s_objet_resultat) == d_erreur)
 1692:         {
 1693:             return;
 1694:         }
 1695:     }
 1696:     else
 1697:     {
 1698:         (*s_etat_processus).erreur_execution =
 1699:                 d_ex_matrice_statistique_invalide;
 1700:         return;
 1701:     }
 1702: 
 1703:     return;
 1704: }
 1705: 
 1706: // vim: ts=4

CVSweb interface <joel.bertrand@systella.fr>