File:  [local] / rpl / src / instructions_p4.c
Revision 1.33: download - view: text, annotated - select for diffs - revision graph
Thu Jan 5 10:19:03 2012 UTC (12 years, 4 months ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_5, HEAD
Mise à jour du copyright.

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

CVSweb interface <joel.bertrand@systella.fr>