File:  [local] / rpl / src / instructions_p4.c
Revision 1.41: download - view: text, annotated - select for diffs - revision graph
Mon Dec 17 21:22:43 2012 UTC (11 years, 4 months ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_11, HEAD
Série de patches pour les variables partagées. Les patches ne provoquent pas
de segfault, mais n'ont pas encore été testés sur des variables partagées.

    1: /*
    2: ================================================================================
    3:   RPL/2 (R) version 4.1.11
    4:   Copyright (C) 1989-2012 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:     int                         i;
  474:     int                         nb_variables;
  475: 
  476:     struct_objet                s_objet;
  477: 
  478:     struct_tableau_variables    *tableau;
  479: 
  480:     (*s_etat_processus).erreur_execution = d_ex;
  481: 
  482:     if ((*s_etat_processus).affichage_arguments == 'Y')
  483:     {
  484:         printf("\n  PRUSR ");
  485: 
  486:         if ((*s_etat_processus).langue == 'F')
  487:         {
  488:             printf("(impression de toutes les variables utilisateur)\n\n");
  489:             printf("  Aucun argument\n");
  490:         }
  491:         else
  492:         {
  493:             printf("(print all user variables)\n\n");
  494:             printf("  No argument\n");
  495:         }
  496: 
  497:         return;
  498:     }
  499:     else if ((*s_etat_processus).test_instruction == 'Y')
  500:     {
  501:         (*s_etat_processus).nombre_arguments = -1;
  502:         return;
  503:     }
  504: 
  505:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  506:     {
  507:         if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
  508:         {
  509:             return;
  510:         }
  511:     }
  512: 
  513:     nb_variables = nombre_variables(s_etat_processus);
  514: 
  515:     if ((tableau = malloc(nb_variables * sizeof(struct_tableau_variables)))
  516:             == NULL)
  517:     {
  518:         liberation_mutexes_arbre_variables_partagees(s_etat_processus,
  519:                 (*(*s_etat_processus).s_arbre_variables_partagees));
  520:         (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  521:         return;
  522:     }
  523: 
  524:     liste_variables(s_etat_processus, tableau);
  525: 
  526:     s_objet.type = CHN;
  527: 
  528:     for(i = 0; i < nb_variables; i++)
  529:     {
  530:         if ((s_objet.objet = malloc((strlen(tableau[i].nom) + 64)
  531:                 * sizeof(unsigned char))) == NULL)
  532:         {
  533:             free(tableau);
  534: 
  535:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  536:             return;
  537:         }
  538: 
  539:         sprintf((unsigned char *) s_objet.objet, "\\\\noindent %s [%lu]\n",
  540:                 tableau[i].nom, tableau[i].niveau);
  541: 
  542:         formateur_tex(s_etat_processus, &s_objet, 'N');
  543:         free(s_objet.objet);
  544:     }
  545: 
  546:     free(tableau);
  547:     return;
  548: }
  549: 
  550: 
  551: /*
  552: ================================================================================
  553:   Fonction 'prmd'
  554: ================================================================================
  555:   Entrées :
  556: --------------------------------------------------------------------------------
  557:   Sorties :
  558: --------------------------------------------------------------------------------
  559:   Effets de bord : néant
  560: ================================================================================
  561: */
  562: 
  563: void
  564: instruction_prmd(struct_processus *s_etat_processus)
  565: {
  566:     long                        longueur_utile;
  567:     long                        longueur_utile_limite;
  568: 
  569:     struct_objet                s_objet;
  570: 
  571:     unsigned long               i;
  572:     unsigned long               j;
  573: 
  574:     (*s_etat_processus).erreur_execution = d_ex;
  575: 
  576:     if ((*s_etat_processus).affichage_arguments == 'Y')
  577:     {
  578:         printf("\n  PRMD ");
  579: 
  580:         if ((*s_etat_processus).langue == 'F')
  581:         {
  582:             printf("(impression de l'état du séquenceur)\n\n");
  583:             printf("  Aucun argument\n");
  584:         }
  585:         else
  586:         {
  587:             printf("(print sequencer state)\n\n");
  588:             printf("  No argument\n");
  589:         }
  590: 
  591:         return;
  592:     }
  593:     else if ((*s_etat_processus).test_instruction == 'Y')
  594:     {
  595:         (*s_etat_processus).nombre_arguments = -1;
  596:         return;
  597:     }
  598: 
  599:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  600:     {
  601:         if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
  602:         {
  603:             return;
  604:         }
  605:     }
  606: 
  607:     s_objet.type = CHN;
  608: 
  609:     if ((s_objet.objet = malloc(128 * sizeof(unsigned char))) == NULL)
  610:     {
  611:         (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  612:         return;
  613:     }
  614: 
  615:     longueur_utile = 0;
  616:     j = 1;
  617: 
  618:     for(i = 53; i <= 56; i++)
  619:     {
  620:         longueur_utile += (test_cfsf(s_etat_processus, (unsigned char) i)
  621:                 == d_vrai) ? j : 0;
  622:         j *= 2;
  623:     }
  624: 
  625:     longueur_utile_limite = 12;
  626: 
  627:     if (longueur_utile > longueur_utile_limite)
  628:     {
  629:         longueur_utile = longueur_utile_limite;
  630:     }
  631: 
  632:     if ((test_cfsf(s_etat_processus, 49) == d_faux) &&
  633:             (test_cfsf(s_etat_processus, 50) == d_faux))
  634:     {
  635:         if ((*s_etat_processus).langue == 'F')
  636:         {
  637:             sprintf((unsigned char *) s_objet.objet,
  638:                     "\\noindent Mode d'affichage numérique: standard\n");
  639:         }
  640:         else
  641:         {
  642:             sprintf((unsigned char *) s_objet.objet,
  643:                     "\\noindent Numerical mode: standard\n");
  644:         }
  645:     }
  646:     else if ((test_cfsf(s_etat_processus, 49) == d_faux) &&
  647:             (test_cfsf(s_etat_processus, 50) == d_vrai))
  648:     {
  649:         if ((*s_etat_processus).langue == 'F')
  650:         {
  651:             sprintf((unsigned char *) s_objet.objet,
  652:                     "\\noindent Mode d'affichage numérique: "
  653:                     "scientifique (%ld)\n", longueur_utile);
  654:         }
  655:         else
  656:         {
  657:             sprintf((unsigned char *) s_objet.objet,
  658:                     "\\noindent Numerical mode: scientific (%ld)\n",
  659:                     longueur_utile);
  660:         }
  661:     }
  662:     else if ((test_cfsf(s_etat_processus, 49) == d_vrai) &&
  663:             (test_cfsf(s_etat_processus, 50) == d_faux))
  664:     {
  665:         if ((*s_etat_processus).langue == 'F')
  666:         {
  667:             sprintf((unsigned char *) s_objet.objet,
  668:                     "\\noindent Mode d'affichage numérique: "
  669:                     "virgule fixe (%ld)\n", longueur_utile);
  670:         }
  671:         else
  672:         {
  673:             sprintf((unsigned char *) s_objet.objet,
  674:                     "\\noindent Numerical mode: fixed point (%ld)\n", longueur_utile);
  675:         }
  676:     }
  677:     else 
  678:     {
  679:         if ((*s_etat_processus).langue == 'F')
  680:         {
  681:             sprintf((unsigned char *) s_objet.objet,
  682:                     "\\noindent Mode d'affichage numérique: notation ingénieur "
  683:                     "(%ld)\n", longueur_utile);
  684:         }
  685:         else
  686:         {
  687:             sprintf((unsigned char *) s_objet.objet,
  688:                     "\\noindent Numerical mode: engineer "
  689:                     "(%ld)\n", longueur_utile);
  690:         }
  691:     }
  692: 
  693: 
  694:     formateur_tex(s_etat_processus, &s_objet, 'N');
  695:     free(s_objet.objet);
  696: 
  697:     if ((s_objet.objet = malloc(128 * sizeof(unsigned char))) == NULL)
  698:     {
  699:         (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  700:         return;
  701:     }
  702: 
  703:     if ((*s_etat_processus).langue == 'F')
  704:     {
  705:         sprintf((unsigned char *) s_objet.objet,
  706:                 "\\noindent \\'Echelle angulaire: %s\n",
  707:                 (test_cfsf(s_etat_processus, 60) == d_faux)
  708:                 ? "degrés" : "radians");
  709:     }
  710:     else
  711:     {
  712:         sprintf((unsigned char *) s_objet.objet,
  713:                 "\\noindent Angular scale: %s\n",
  714:                 (test_cfsf(s_etat_processus, 60) == d_faux)
  715:                 ? "degrees" : "radians");
  716:     }
  717: 
  718:     formateur_tex(s_etat_processus, &s_objet, 'N');
  719:     free(s_objet.objet);
  720: 
  721:     if ((s_objet.objet = malloc(128 * sizeof(unsigned char))) == NULL)
  722:     {
  723:         (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  724:         return;
  725:     }
  726: 
  727:     if ((test_cfsf(s_etat_processus, 43) == d_faux) &&
  728:             (test_cfsf(s_etat_processus, 44) == d_faux))
  729:     {
  730:         if ((*s_etat_processus).langue == 'F')
  731:         {
  732:             sprintf((unsigned char *) s_objet.objet,
  733:                     "\\noindent Base des entiers : décimale\n");
  734:         }
  735:         else
  736:         {
  737:             sprintf((unsigned char *) s_objet.objet,
  738:                     "\\noindent Integer base: decimal\n");
  739:         }
  740:     }
  741:     else if ((test_cfsf(s_etat_processus, 43) == d_vrai) &&
  742:             (test_cfsf(s_etat_processus, 44) == d_faux))
  743:     {
  744:         if ((*s_etat_processus).langue == 'F')
  745:         {
  746:             sprintf((unsigned char *) s_objet.objet,
  747:                     "\\noindent Base des entiers : octale\n");
  748:         }
  749:         else
  750:         {
  751:             sprintf((unsigned char *) s_objet.objet,
  752:                     "\\noindent Integer base: octal\n");
  753:         }
  754:     }
  755:     else if ((test_cfsf(s_etat_processus, 43) == d_vrai) &&
  756:             (test_cfsf(s_etat_processus, 44) == d_vrai))
  757:     {
  758:         if ((*s_etat_processus).langue == 'F')
  759:         {
  760:             sprintf((unsigned char *) s_objet.objet,
  761:                     "\\noindent Base des entiers : hexadécimale\n");
  762:         }
  763:         else
  764:         {
  765:             sprintf((unsigned char *) s_objet.objet,
  766:                     "\\noindent Integer base: hexadecimal\n");
  767:         }
  768:     }
  769:     else
  770:     {
  771:         if ((*s_etat_processus).langue == 'F')
  772:         {
  773:             sprintf((unsigned char *) s_objet.objet,
  774:                     "\\noindent Base des entiers : binaire\n");
  775:         }
  776:         else
  777:         {
  778:             sprintf((unsigned char *) s_objet.objet,
  779:                     "\\noindent Integer base: binary\n");
  780:         }
  781:     }
  782:     
  783:     formateur_tex(s_etat_processus, &s_objet, 'N');
  784:     free(s_objet.objet);
  785: 
  786:     if ((s_objet.objet = malloc(128 * sizeof(unsigned char))) == NULL)
  787:     {
  788:         (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  789:         return;
  790:     }
  791: 
  792:     if ((*s_etat_processus).langue == 'F')
  793:     {
  794:         sprintf((unsigned char *) s_objet.objet,
  795:                 "\\noindent Longueur des entiers : %d bits\n",
  796:                 longueur_entiers_binaires(s_etat_processus));
  797:     }
  798:     else
  799:     {
  800:         sprintf((unsigned char *) s_objet.objet,
  801:                 "\\noindent Length of integers: %d bits\n",
  802:                 longueur_entiers_binaires(s_etat_processus));
  803:     }
  804: 
  805:     formateur_tex(s_etat_processus, &s_objet, 'N');
  806:     free(s_objet.objet);
  807: 
  808:     if ((s_objet.objet = malloc(128 * sizeof(unsigned char))) == NULL)
  809:     {
  810:         (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  811:         return;
  812:     }
  813: 
  814:     if ((*s_etat_processus).langue == 'F')
  815:     {
  816:         sprintf((unsigned char *) s_objet.objet,
  817:                 "\\noindent Séparateur décimal: %s\n",
  818:                 (test_cfsf(s_etat_processus, 48) == d_faux)
  819:                 ? "point" : "virgule");
  820:     }
  821:     else
  822:     {
  823:         sprintf((unsigned char *) s_objet.objet,
  824:                 "\\noindent Radix: %s\n",
  825:                 (test_cfsf(s_etat_processus, 48) == d_faux)
  826:                 ? "period" : "coma");
  827:     }
  828: 
  829:     formateur_tex(s_etat_processus, &s_objet, 'N');
  830:     free(s_objet.objet);
  831: 
  832:     return;
  833: }
  834: 
  835: 
  836: /*
  837: ================================================================================
  838:   Fonction 'pmin'
  839: ================================================================================
  840:   Entrées :
  841: --------------------------------------------------------------------------------
  842:   Sorties :
  843: --------------------------------------------------------------------------------
  844:   Effets de bord : néant
  845: ================================================================================
  846: */
  847: 
  848: void
  849: instruction_pmin(struct_processus *s_etat_processus)
  850: {
  851:     struct_objet                    *s_objet;
  852: 
  853:     (*s_etat_processus).erreur_execution = d_ex;
  854: 
  855:     if ((*s_etat_processus).affichage_arguments == 'Y')
  856:     {
  857:         printf("\n  PMIN ");
  858: 
  859:         if ((*s_etat_processus).langue == 'F')
  860:         {
  861:             printf("(minima d'un graphique 2D)\n\n");
  862:         }
  863:         else
  864:         {
  865:             printf("(2D-graphic minima)\n\n");
  866:         }
  867: 
  868:         printf("    1: %s\n", d_CPL);
  869: 
  870:         return;
  871:     }
  872:     else if ((*s_etat_processus).test_instruction == 'Y')
  873:     {
  874:         (*s_etat_processus).nombre_arguments = -1;
  875:         return;
  876:     }
  877: 
  878:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  879:     {
  880:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
  881:         {
  882:             return;
  883:         }
  884:     }
  885: 
  886:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  887:             &s_objet) == d_erreur)
  888:     {
  889:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
  890:         return;
  891:     }
  892: 
  893:     if ((*s_objet).type == CPL)
  894:     {
  895:         if ((*s_etat_processus).systeme_axes == 0)
  896:         {
  897:             (*s_etat_processus).x_min = (*((complex16 *) (*s_objet).objet))
  898:                     .partie_reelle;
  899:             (*s_etat_processus).y_min = (*((complex16 *) (*s_objet).objet))
  900:                     .partie_imaginaire;
  901:         }
  902:         else
  903:         {
  904:             (*s_etat_processus).x2_min = (*((complex16 *) (*s_objet).objet))
  905:                     .partie_reelle;
  906:             (*s_etat_processus).y2_min = (*((complex16 *) (*s_objet).objet))
  907:                     .partie_imaginaire;
  908:         }
  909:     }
  910:     else
  911:     {
  912:         liberation(s_etat_processus, s_objet);
  913: 
  914:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
  915:         return;
  916:     }
  917: 
  918:     liberation(s_etat_processus, s_objet);
  919: 
  920:     if (test_cfsf(s_etat_processus, 52) == d_faux)
  921:     {
  922:         if ((*s_etat_processus).fichiers_graphiques != NULL)
  923:         {
  924:             appel_gnuplot(s_etat_processus, 'N');
  925:         }
  926:     }
  927: 
  928:     return;
  929: }
  930: 
  931: 
  932: /*
  933: ================================================================================
  934:   Fonction 'pmax'
  935: ================================================================================
  936:   Entrées :
  937: --------------------------------------------------------------------------------
  938:   Sorties :
  939: --------------------------------------------------------------------------------
  940:   Effets de bord : néant
  941: ================================================================================
  942: */
  943: 
  944: void
  945: instruction_pmax(struct_processus *s_etat_processus)
  946: {
  947:     struct_objet                    *s_objet;
  948: 
  949:     (*s_etat_processus).erreur_execution = d_ex;
  950: 
  951:     if ((*s_etat_processus).affichage_arguments == 'Y')
  952:     {
  953:         printf("\n  PMAX ");
  954: 
  955:         if ((*s_etat_processus).langue == 'F')
  956:         {
  957:             printf("(maxima d'un graphique 2D)\n\n");
  958:         }
  959:         else
  960:         {
  961:             printf("(2D-graphic maxima)\n\n");
  962:         }
  963: 
  964:         printf("    1: %s\n", d_CPL);
  965: 
  966:         return;
  967:     }
  968:     else if ((*s_etat_processus).test_instruction == 'Y')
  969:     {
  970:         (*s_etat_processus).nombre_arguments = -1;
  971:         return;
  972:     }
  973: 
  974:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  975:     {
  976:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
  977:         {
  978:             return;
  979:         }
  980:     }
  981: 
  982:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  983:             &s_objet) == d_erreur)
  984:     {
  985:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
  986:         return;
  987:     }
  988: 
  989:     if ((*s_objet).type == CPL)
  990:     {
  991:         if ((*s_etat_processus).systeme_axes == 0)
  992:         {
  993:             (*s_etat_processus).x_max = (*((complex16 *) (*s_objet).objet))
  994:                     .partie_reelle;
  995:             (*s_etat_processus).y_max = (*((complex16 *) (*s_objet).objet))
  996:                     .partie_imaginaire;
  997:         }
  998:         else
  999:         {
 1000:             (*s_etat_processus).x2_max = (*((complex16 *) (*s_objet).objet))
 1001:                     .partie_reelle;
 1002:             (*s_etat_processus).y2_max = (*((complex16 *) (*s_objet).objet))
 1003:                     .partie_imaginaire;
 1004:         }
 1005:     }
 1006:     else
 1007:     {
 1008:         liberation(s_etat_processus, s_objet);
 1009: 
 1010:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 1011:         return;
 1012:     }
 1013: 
 1014:     liberation(s_etat_processus, s_objet);
 1015: 
 1016:     if (test_cfsf(s_etat_processus, 52) == d_faux)
 1017:     {
 1018:         if ((*s_etat_processus).fichiers_graphiques != NULL)
 1019:         {
 1020:             appel_gnuplot(s_etat_processus, 'N');
 1021:         }
 1022:     }
 1023: 
 1024:     return;
 1025: }
 1026: 
 1027: 
 1028: /*
 1029: ================================================================================
 1030:   Fonction 'persist'
 1031: ================================================================================
 1032:   Entrées :
 1033: --------------------------------------------------------------------------------
 1034:   Sorties :
 1035: --------------------------------------------------------------------------------
 1036:   Effets de bord : néant
 1037: ================================================================================
 1038: */
 1039: 
 1040: void
 1041: instruction_persist(struct_processus *s_etat_processus)
 1042: {
 1043:     (*s_etat_processus).erreur_execution = d_ex;
 1044: 
 1045:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1046:     {
 1047:         printf("\n  PERSIST ");
 1048: 
 1049:         if ((*s_etat_processus).langue == 'F')
 1050:         {
 1051:             printf("(détachement d'un graphique)\n\n");
 1052:             printf("  Aucun argument\n");
 1053:         }
 1054:         else
 1055:         {
 1056:             printf("(spawn a graphic output)\n\n");
 1057:             printf("  No argument\n");
 1058:         }
 1059: 
 1060:         return;
 1061:     }
 1062:     else if ((*s_etat_processus).test_instruction == 'Y')
 1063:     {
 1064:         (*s_etat_processus).nombre_arguments = -1;
 1065:         return;
 1066:     }
 1067: 
 1068:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1069:     {
 1070:         if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
 1071:         {
 1072:             return;
 1073:         }
 1074:     }
 1075: 
 1076:     appel_gnuplot(s_etat_processus, 'E');
 1077: 
 1078:     return;
 1079: }
 1080: 
 1081: 
 1082: /*
 1083: ================================================================================
 1084:   Fonction 'polar' (passe en mode d'affichage r=f(t))
 1085: ================================================================================
 1086:   Entrées : structure processus
 1087: --------------------------------------------------------------------------------
 1088:   Sorties :
 1089: --------------------------------------------------------------------------------
 1090:   Effets de bord : néant
 1091: ================================================================================
 1092: */
 1093: 
 1094: void
 1095: instruction_polar(struct_processus *s_etat_processus)
 1096: {
 1097:     (*s_etat_processus).erreur_execution = d_ex;
 1098: 
 1099:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1100:     {
 1101:         printf("\n  POLAR ");
 1102: 
 1103:         if ((*s_etat_processus).langue == 'F')
 1104:         {
 1105:             printf("(tracé théta=f(r))\n\n");
 1106:             printf("  Aucun argument\n");
 1107:         }
 1108:         else
 1109:         {
 1110:             printf("(plot theta=f(r))\n\n");
 1111:             printf("  No argument\n");
 1112:         }
 1113: 
 1114:         return;
 1115:     }
 1116:     else if ((*s_etat_processus).test_instruction == 'Y')
 1117:     {
 1118:         (*s_etat_processus).nombre_arguments = -1;
 1119:         return;
 1120:     }
 1121:     
 1122:     strcpy((*s_etat_processus).type_trace_eq, "POLAIRE");
 1123: 
 1124:     return;
 1125: }
 1126: 
 1127: 
 1128: /*
 1129: ================================================================================
 1130:   Fonction 'parametric' (passe en mode d'affichage r=f(t))
 1131: ================================================================================
 1132:   Entrées : structure processus
 1133: --------------------------------------------------------------------------------
 1134:   Sorties :
 1135: --------------------------------------------------------------------------------
 1136:   Effets de bord : néant
 1137: ================================================================================
 1138: */
 1139: 
 1140: void
 1141: instruction_parametric(struct_processus *s_etat_processus)
 1142: {
 1143:     (*s_etat_processus).erreur_execution = d_ex;
 1144: 
 1145:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1146:     {
 1147:         printf("\n  PARAMETRIC ");
 1148: 
 1149:         if ((*s_etat_processus).langue == 'F')
 1150:         {
 1151:             printf("(tracé (x,y)=f(t)+i*g(t))\n\n");
 1152:             printf("  Aucun argument\n");
 1153:         }
 1154:         else
 1155:         {
 1156:             printf("(plot (x,y)=f(t)+i*g(t))\n\n");
 1157:             printf("  No argument\n");
 1158:         }
 1159: 
 1160:         return;
 1161:     }
 1162:     else if ((*s_etat_processus).test_instruction == 'Y')
 1163:     {
 1164:         (*s_etat_processus).nombre_arguments = -1;
 1165:         return;
 1166:     }
 1167:     
 1168:     strcpy((*s_etat_processus).type_trace_eq, "PARAMETRIQUE");
 1169: 
 1170:     return;
 1171: }
 1172: 
 1173: 
 1174: /*
 1175: ================================================================================
 1176:   Fonction 'perm'
 1177: ================================================================================
 1178:   Entrées :
 1179: --------------------------------------------------------------------------------
 1180:   Sorties :
 1181: --------------------------------------------------------------------------------
 1182:   Effets de bord : néant
 1183: ================================================================================
 1184: */
 1185: 
 1186: void
 1187: instruction_perm(struct_processus *s_etat_processus)
 1188: {
 1189:     integer8                        k;
 1190:     integer8                        n;
 1191:     integer8                        cint_max;
 1192: 
 1193:     real8                           c;
 1194: 
 1195:     struct_objet                    *s_objet_argument_1;
 1196:     struct_objet                    *s_objet_argument_2;
 1197:     struct_objet                    *s_objet_resultat;
 1198: 
 1199:     unsigned long                   i;
 1200: 
 1201:     (*s_etat_processus).erreur_execution = d_ex;
 1202: 
 1203:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1204:     {
 1205:         printf("\n  PERM ");
 1206: 
 1207:         if ((*s_etat_processus).langue == 'F')
 1208:         {
 1209:             printf("(permutation)\n\n");
 1210:         }
 1211:         else
 1212:         {
 1213:             printf("(permutation)\n\n");
 1214:         }
 1215: 
 1216:         printf("    2: %s\n", d_INT);
 1217:         printf("    1: %s\n", d_INT);
 1218:         printf("->  1: %s, %s\n", d_INT, d_REL);
 1219: 
 1220:         return;
 1221:     }
 1222:     else if ((*s_etat_processus).test_instruction == 'Y')
 1223:     {
 1224:         (*s_etat_processus).nombre_arguments = 2;
 1225:         return;
 1226:     }
 1227:     
 1228:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1229:     {
 1230:         if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
 1231:         {
 1232:             return;
 1233:         }
 1234:     }
 1235: 
 1236:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1237:             &s_objet_argument_1) == d_erreur)
 1238:     {
 1239:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1240:         return;
 1241:     }
 1242: 
 1243:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1244:             &s_objet_argument_2) == d_erreur)
 1245:     {
 1246:         liberation(s_etat_processus, s_objet_argument_1);
 1247: 
 1248:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1249:         return;
 1250:     }
 1251: 
 1252:     if (((*s_objet_argument_1).type == INT) &&
 1253:             ((*s_objet_argument_2).type == INT))
 1254:     {
 1255:         n = (*((integer8 *) (*s_objet_argument_2).objet));
 1256:         k = (*((integer8 *) (*s_objet_argument_1).objet));
 1257: 
 1258:         if ((n < 0) || (k < 0) || (k > n))
 1259:         {
 1260:             liberation(s_etat_processus, s_objet_argument_1);
 1261:             liberation(s_etat_processus, s_objet_argument_2);
 1262: 
 1263:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
 1264:             return;
 1265:         }
 1266: 
 1267:         f90arrangement(&n, &k, &c);
 1268: 
 1269:         for(i = 1, cint_max = 1; i < (8 * sizeof(integer8)) - 1; cint_max =
 1270:                 (cint_max << 1) + 1, i++);
 1271: 
 1272:         if (c > cint_max)
 1273:         {
 1274:             if ((s_objet_resultat = allocation(s_etat_processus, REL))
 1275:                     == NULL)
 1276:             {
 1277:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1278:                 return;
 1279:             }
 1280: 
 1281:             (*((real8 *) (*s_objet_resultat).objet)) = c;
 1282:         }
 1283:         else
 1284:         {
 1285:             if ((s_objet_resultat = allocation(s_etat_processus, INT))
 1286:                     == NULL)
 1287:             {
 1288:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1289:                 return;
 1290:             }
 1291: 
 1292:             if (fabs(c - floor(c)) < fabs(ceil(c) - c))
 1293:             {
 1294:                 (*((integer8 *) (*s_objet_resultat).objet)) =
 1295:                         (integer8) floor(c);
 1296:             } 
 1297:             else
 1298:             {
 1299:                 (*((integer8 *) (*s_objet_resultat).objet)) =
 1300:                         1 + (integer8) floor(c);
 1301:             } 
 1302:         }
 1303:     }
 1304:     else
 1305:     {
 1306:         liberation(s_etat_processus, s_objet_argument_1);
 1307:         liberation(s_etat_processus, s_objet_argument_2);
 1308: 
 1309:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 1310:         return;
 1311:     }
 1312: 
 1313:     liberation(s_etat_processus, s_objet_argument_1);
 1314:     liberation(s_etat_processus, s_objet_argument_2);
 1315: 
 1316:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1317:             s_objet_resultat) == d_erreur)
 1318:     {
 1319:         return;
 1320:     }
 1321: 
 1322:     return;
 1323: }
 1324: 
 1325: 
 1326: /*
 1327: ================================================================================
 1328:   Fonction 'psdev'
 1329: ================================================================================
 1330:   Entrées :
 1331: --------------------------------------------------------------------------------
 1332:   Sorties :
 1333: --------------------------------------------------------------------------------
 1334:   Effets de bord : néant
 1335: ================================================================================
 1336: */
 1337: 
 1338: void
 1339: instruction_psdev(struct_processus *s_etat_processus)
 1340: {
 1341:     struct_objet                        *s_objet_statistique;
 1342:     struct_objet                        *s_objet_resultat;
 1343:     struct_objet                        *s_objet_temporaire;
 1344: 
 1345:     unsigned long                       nombre_colonnes;
 1346: 
 1347:     (*s_etat_processus).erreur_execution = d_ex;
 1348: 
 1349:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1350:     {
 1351:         printf("\n  PSDEV ");
 1352: 
 1353:         if ((*s_etat_processus).langue == 'F')
 1354:         {
 1355:             printf("(écart-type d'une population)\n\n");
 1356:         }
 1357:         else
 1358:         {
 1359:             printf("(population standard deviation)\n\n");
 1360:         }
 1361: 
 1362:         printf("->  1: %s, %s, %s, %s\n", d_INT, d_REL, d_VIN, d_VRL);
 1363: 
 1364:         return;
 1365:     }
 1366:     else if ((*s_etat_processus).test_instruction == 'Y')
 1367:     {
 1368:         (*s_etat_processus).nombre_arguments = -1;
 1369:         return;
 1370:     }
 1371: 
 1372:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1373:     {
 1374:         if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
 1375:         {
 1376:             return;
 1377:         }
 1378:     }
 1379: 
 1380:     /*
 1381:      * Recherche d'une variable globale référencée par SIGMA
 1382:      */
 1383: 
 1384:     if (recherche_variable_globale(s_etat_processus, ds_sdat) == d_faux)
 1385:     {
 1386:         /*
 1387:          * Aucune variable SIGMA
 1388:          */
 1389: 
 1390:         (*s_etat_processus).erreur_systeme = d_es;
 1391: 
 1392:         if ((*s_etat_processus).erreur_execution == d_ex)
 1393:         {
 1394:             (*s_etat_processus).erreur_execution = d_ex_absence_observations;
 1395:         }
 1396: 
 1397:         return;
 1398:     }
 1399:     else
 1400:     {
 1401:         if (((*(*(*s_etat_processus).pointeur_variable_courante).objet)
 1402:                 .type != MIN) && ((*(*(*s_etat_processus)
 1403:                 .pointeur_variable_courante).objet).type != MRL))
 1404:         {
 1405:             (*s_etat_processus).erreur_execution =
 1406:                     d_ex_matrice_statistique_invalide;
 1407:             return;
 1408:         }
 1409: 
 1410:         nombre_colonnes = (*((struct_matrice *) (*(*(*s_etat_processus)
 1411:                 .pointeur_variable_courante).objet).objet)).nombre_colonnes;
 1412:     }
 1413: 
 1414:     s_objet_statistique = (*(*s_etat_processus).pointeur_variable_courante)
 1415:             .objet;
 1416: 
 1417:     if (((*s_objet_statistique).type == MIN) ||
 1418:             ((*s_objet_statistique).type == MRL))
 1419:     {
 1420:         if ((s_objet_resultat = allocation(s_etat_processus, NON)) == NULL)
 1421:         {
 1422:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1423:             return;
 1424:         }
 1425: 
 1426:         if (((*s_objet_resultat).objet = ecart_type_statistique(
 1427:                 (struct_matrice *) (*s_objet_statistique).objet, 'P')) == NULL)
 1428:         {
 1429:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1430:             return;
 1431:         }
 1432: 
 1433:         if (nombre_colonnes == 1)
 1434:         {
 1435:             if ((*((struct_vecteur *) (*s_objet_resultat).objet)).type == 'I')
 1436:             {
 1437:                 (*s_objet_resultat).type = VIN;
 1438:                 s_objet_temporaire = s_objet_resultat;
 1439: 
 1440:                 if ((s_objet_resultat = allocation(s_etat_processus, INT))
 1441:                         == NULL)
 1442:                 {
 1443:                     (*s_etat_processus).erreur_systeme =
 1444:                             d_es_allocation_memoire;
 1445:                     return;
 1446:                 }
 1447: 
 1448:                 (*((integer8 *) (*s_objet_resultat).objet)) =
 1449:                         ((integer8 *) (*((struct_vecteur *)
 1450:                         (*s_objet_temporaire).objet)).tableau)[0];
 1451: 
 1452:                 liberation(s_etat_processus, s_objet_temporaire);
 1453:             }
 1454:             else
 1455:             {
 1456:                 (*s_objet_resultat).type = VRL;
 1457:                 s_objet_temporaire = s_objet_resultat;
 1458: 
 1459:                 if ((s_objet_resultat = allocation(s_etat_processus, REL))
 1460:                         == NULL)
 1461:                 {
 1462:                     (*s_etat_processus).erreur_systeme =
 1463:                             d_es_allocation_memoire;
 1464:                     return;
 1465:                 }
 1466: 
 1467:                 (*((real8 *) (*s_objet_resultat).objet)) =
 1468:                         ((real8 *) (*((struct_vecteur *)
 1469:                         (*s_objet_temporaire).objet)).tableau)[0];
 1470: 
 1471:                 liberation(s_etat_processus, s_objet_temporaire);
 1472:             }
 1473:         }
 1474:         else
 1475:         {
 1476:             if ((*((struct_vecteur *) (*s_objet_resultat).objet)).type == 'I')
 1477:             {
 1478:                 (*s_objet_resultat).type = VIN;
 1479:             }
 1480:             else
 1481:             {
 1482:                 (*s_objet_resultat).type = VRL;
 1483:             }
 1484:         }
 1485: 
 1486:         if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1487:                 s_objet_resultat) == d_erreur)
 1488:         {
 1489:             return;
 1490:         }
 1491:     }
 1492:     else
 1493:     {
 1494:         (*s_etat_processus).erreur_execution =
 1495:                 d_ex_matrice_statistique_invalide;
 1496:         return;
 1497:     }
 1498: 
 1499:     return;
 1500: }
 1501: 
 1502: 
 1503: /*
 1504: ================================================================================
 1505:   Fonction 'pvar'
 1506: ================================================================================
 1507:   Entrées :
 1508: --------------------------------------------------------------------------------
 1509:   Sorties :
 1510: --------------------------------------------------------------------------------
 1511:   Effets de bord : néant
 1512: ================================================================================
 1513: */
 1514: 
 1515: void
 1516: instruction_pvar(struct_processus *s_etat_processus)
 1517: {
 1518:     struct_objet                        *s_objet_statistique;
 1519:     struct_objet                        *s_objet_resultat;
 1520:     struct_objet                        *s_objet_temporaire;
 1521: 
 1522:     unsigned long                       nombre_colonnes;
 1523: 
 1524:     (*s_etat_processus).erreur_execution = d_ex;
 1525: 
 1526:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1527:     {
 1528:         printf("\n  PVAR ");
 1529: 
 1530:         if ((*s_etat_processus).langue == 'F')
 1531:         {
 1532:             printf("(variance d'une population)\n\n");
 1533:         }
 1534:         else
 1535:         {
 1536:             printf("(population variance)\n\n");
 1537:         }
 1538: 
 1539:         printf("->  1: %s, %s, %s, %s\n", d_INT, d_REL, d_VIN, d_VRL);
 1540: 
 1541:         return;
 1542:     }
 1543:     else if ((*s_etat_processus).test_instruction == 'Y')
 1544:     {
 1545:         (*s_etat_processus).nombre_arguments = -1;
 1546:         return;
 1547:     }
 1548: 
 1549:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1550:     {
 1551:         if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
 1552:         {
 1553:             return;
 1554:         }
 1555:     }
 1556: 
 1557:     /*
 1558:      * Recherche d'une variable globale référencée par SIGMA
 1559:      */
 1560: 
 1561:     if (recherche_variable_globale(s_etat_processus, ds_sdat) == d_faux)
 1562:     {
 1563:         /*
 1564:          * Aucune variable SIGMA
 1565:          */
 1566: 
 1567:         (*s_etat_processus).erreur_systeme = d_es;
 1568: 
 1569:         if ((*s_etat_processus).erreur_execution == d_ex)
 1570:         {
 1571:             (*s_etat_processus).erreur_execution = d_ex_absence_observations;
 1572:         }
 1573: 
 1574:         return;
 1575:     }
 1576:     else
 1577:     {
 1578:         if (((*(*(*s_etat_processus).pointeur_variable_courante).objet)
 1579:                 .type != MIN) && ((*(*(*s_etat_processus)
 1580:                 .pointeur_variable_courante).objet).type != MRL))
 1581:         {
 1582:             (*s_etat_processus).erreur_execution =
 1583:                     d_ex_matrice_statistique_invalide;
 1584:             return;
 1585:         }
 1586: 
 1587:         nombre_colonnes = (*((struct_matrice *) (*(*(*s_etat_processus)
 1588:                 .pointeur_variable_courante).objet).objet)).nombre_colonnes;
 1589:     }
 1590: 
 1591:     s_objet_statistique = (*(*s_etat_processus).pointeur_variable_courante)
 1592:             .objet;
 1593: 
 1594:     if (((*s_objet_statistique).type == MIN) ||
 1595:             ((*s_objet_statistique).type == MRL))
 1596:     {
 1597:         if ((s_objet_resultat = allocation(s_etat_processus, NON))
 1598:                 == NULL)
 1599:         {
 1600:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1601:             return;
 1602:         }
 1603: 
 1604:         if (((*s_objet_resultat).objet = variance_statistique((struct_matrice *)
 1605:                 (*s_objet_statistique).objet, 'P')) == NULL)
 1606:         {
 1607:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1608:             return;
 1609:         }
 1610: 
 1611:         if (nombre_colonnes == 1)
 1612:         {
 1613:             if ((*((struct_vecteur *) (*s_objet_resultat).objet)).type == 'I')
 1614:             {
 1615:                 (*s_objet_resultat).type = VIN;
 1616:                 s_objet_temporaire = s_objet_resultat;
 1617: 
 1618:                 if ((s_objet_resultat = allocation(s_etat_processus, INT))
 1619:                         == NULL)
 1620:                 {
 1621:                     (*s_etat_processus).erreur_systeme =
 1622:                             d_es_allocation_memoire;
 1623:                     return;
 1624:                 }
 1625: 
 1626:                 (*((integer8 *) (*s_objet_resultat).objet)) =
 1627:                         ((integer8 *) (*((struct_vecteur *)
 1628:                         (*s_objet_temporaire).objet)).tableau)[0];
 1629: 
 1630:                 liberation(s_etat_processus, s_objet_temporaire);
 1631:             }
 1632:             else
 1633:             {
 1634:                 (*s_objet_resultat).type = VRL;
 1635:                 s_objet_temporaire = s_objet_resultat;
 1636: 
 1637:                 if ((s_objet_resultat = allocation(s_etat_processus, REL))
 1638:                         == NULL)
 1639:                 {
 1640:                     (*s_etat_processus).erreur_systeme =
 1641:                             d_es_allocation_memoire;
 1642:                     return;
 1643:                 }
 1644: 
 1645:                 (*((real8 *) (*s_objet_resultat).objet)) =
 1646:                         ((real8 *) (*((struct_vecteur *)
 1647:                         (*s_objet_temporaire).objet)).tableau)[0];
 1648: 
 1649:                 liberation(s_etat_processus, s_objet_temporaire);
 1650:             }
 1651:         }
 1652:         else
 1653:         {
 1654:             if ((*((struct_vecteur *) (*s_objet_resultat).objet)).type == 'I')
 1655:             {
 1656:                 (*s_objet_resultat).type = VIN;
 1657:             }
 1658:             else
 1659:             {
 1660:                 (*s_objet_resultat).type = VRL;
 1661:             }
 1662:         }
 1663: 
 1664:         if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1665:                 s_objet_resultat) == d_erreur)
 1666:         {
 1667:             return;
 1668:         }
 1669:     }
 1670:     else
 1671:     {
 1672:         (*s_etat_processus).erreur_execution =
 1673:                 d_ex_matrice_statistique_invalide;
 1674:         return;
 1675:     }
 1676: 
 1677:     return;
 1678: }
 1679: 
 1680: // vim: ts=4

CVSweb interface <joel.bertrand@systella.fr>