File:  [local] / rpl / src / instructions_p4.c
Revision 1.12: download - view: text, annotated - select for diffs - revision graph
Fri Aug 6 15:33:02 2010 UTC (13 years, 9 months ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_0_18, HEAD
Cohérence

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

CVSweb interface <joel.bertrand@systella.fr>