File:  [local] / rpl / src / instructions_p4.c
Revision 1.28: download - view: text, annotated - select for diffs - revision graph
Mon Jul 25 07:44:58 2011 UTC (12 years, 9 months ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_2, HEAD
En route pour la 4.1.2.

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

CVSweb interface <joel.bertrand@systella.fr>