File:  [local] / rpl / src / instructions_s4.c
Revision 1.17.2.1: download - view: text, annotated - select for diffs - revision graph
Mon Apr 11 13:02:25 2011 UTC (13 years ago) by bertrand
Branches: rpl-4_0
CVS tags: rpl-4_0_22
Diff to: branchpoint 1.17: preferred, colored
En route vers la 4.0.22.

    1: /*
    2: ================================================================================
    3:   RPL/2 (R) version 4.0.22
    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 'steq'
   29: ================================================================================
   30:   Entrées : structure processus
   31: --------------------------------------------------------------------------------
   32:   Sorties :
   33: --------------------------------------------------------------------------------
   34:   Effets de bord : néant
   35: ================================================================================
   36: */
   37: 
   38: void
   39: instruction_steq(struct_processus *s_etat_processus)
   40: {
   41:     logical1                            presence_variable;
   42: 
   43:     long                                i;
   44: 
   45:     struct_objet                        *s_objet;
   46: 
   47:     struct_variable                     s_variable;
   48: 
   49:     (*s_etat_processus).erreur_execution = d_ex;
   50: 
   51:     if ((*s_etat_processus).affichage_arguments == 'Y')
   52:     {
   53:         printf("\n  STEQ ");
   54: 
   55:         if ((*s_etat_processus).langue == 'F')
   56:         {
   57:             printf("(affecte un objet à la variable EQ)\n\n");
   58:         }
   59:         else
   60:         {
   61:             printf("(store an object in EQ variable)\n\n");
   62:         }
   63: 
   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, %s, %s, %s,\n"
   68:                 "       %s, %s\n",
   69:                 d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
   70:                 d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
   71:                 d_SQL, d_SLB, d_PRC, d_MTX);
   72: 
   73:         return;
   74:     }
   75:     else if ((*s_etat_processus).test_instruction == 'Y')
   76:     {
   77:         (*s_etat_processus).nombre_arguments = -1;
   78:         return;
   79:     }
   80:     
   81:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
   82:     {
   83:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
   84:         {
   85:             return;
   86:         }
   87:     }
   88: 
   89:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
   90:             &s_objet) == d_erreur)
   91:     {
   92:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
   93:         return;
   94:     }
   95: 
   96:     if (recherche_variable(s_etat_processus, "EQ") == d_vrai)
   97:     {
   98:         /*
   99:          * La variable préexiste. Il faut tester si celle-ci est globale
  100:          * (de niveau 1).
  101:          */
  102: 
  103:         i = (*s_etat_processus).position_variable_courante;
  104:         presence_variable = d_faux;
  105: 
  106:         while(i >= 0)
  107:         {
  108:             if ((strcmp((*s_etat_processus).s_liste_variables[i].nom, "EQ")
  109:                     == 0) && ((*s_etat_processus).s_liste_variables[i]
  110:                     .niveau == 1))
  111:             {
  112:                 presence_variable = d_vrai;
  113:                 break;
  114:             }
  115:              i--;
  116:         }
  117: 
  118:         (*s_etat_processus).position_variable_courante = i;
  119: 
  120:         if (presence_variable == d_vrai)
  121:         {
  122:             if ((*s_etat_processus).s_liste_variables[(*s_etat_processus)
  123:                     .position_variable_courante].variable_verrouillee ==
  124:                     d_vrai)
  125:             {
  126:                 liberation(s_etat_processus, s_objet);
  127: 
  128:                 (*s_etat_processus).erreur_execution =
  129:                         d_ex_variable_verrouillee;
  130:                 return;
  131:             }
  132: 
  133:             if ((*s_etat_processus).s_liste_variables[i].objet == NULL)
  134:             {
  135:                 liberation(s_etat_processus, s_objet);
  136: 
  137:                 (*s_etat_processus).erreur_execution = d_ex_variable_partagee;
  138:                 return;
  139:             }
  140: 
  141:             liberation(s_etat_processus,
  142:                     (*s_etat_processus).s_liste_variables[(*s_etat_processus)
  143:                     .position_variable_courante].objet);
  144: 
  145:             (*s_etat_processus).s_liste_variables[(*s_etat_processus)
  146:                     .position_variable_courante].objet = s_objet;
  147:         }
  148:         else
  149:         {
  150:             if ((s_variable.nom = malloc(3 * sizeof(unsigned char))) == NULL)
  151:             {
  152:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  153:                 return;
  154:             }
  155: 
  156:             strcpy(s_variable.nom, "EQ");
  157:             s_variable.niveau = 1;
  158: 
  159:             /*
  160:              * Le niveau 0 correspond aux définitions. Les variables
  161:              * commencent à 1 car elles sont toujours incluses dans
  162:              * une définition.
  163:              */
  164: 
  165:             s_variable.objet = s_objet;
  166: 
  167:             if (creation_variable(s_etat_processus, &s_variable, 'V', 'P') 
  168:                     == d_erreur)
  169:             {
  170:                 return;
  171:             }
  172:         }
  173:     }
  174:     else
  175:     {
  176:         /*
  177:          * La variable n'existe pas et on crée une variable globale.
  178:          */
  179: 
  180:         if ((s_variable.nom = malloc(3 * sizeof(unsigned char))) == NULL)
  181:         {
  182:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  183:             return;
  184:         }
  185: 
  186:         strcpy(s_variable.nom, "EQ");
  187:         s_variable.niveau = 1;
  188: 
  189:         /*
  190:          * Le niveau 0 correspond aux définitions. Les variables
  191:          * commencent à 1 car elles sont toujours incluses dans
  192:          * une définition.
  193:          */
  194: 
  195:         s_variable.objet = s_objet;
  196: 
  197:         if (creation_variable(s_etat_processus, &s_variable, 'V', 'P')
  198:                 == d_erreur)
  199:         {
  200:             return;
  201:         }
  202: 
  203:         (*s_etat_processus).erreur_systeme = d_es;
  204:     }
  205: 
  206:     return;
  207: }
  208: 
  209: 
  210: /*
  211: ================================================================================
  212:   Fonction '*w'
  213: ================================================================================
  214:   Entrées : pointeur sur une structure struct_processus
  215: --------------------------------------------------------------------------------
  216:   Sorties :
  217: --------------------------------------------------------------------------------
  218:   Effets de bord : néant
  219: ================================================================================
  220: */
  221: 
  222: void
  223: instruction_star_w(struct_processus *s_etat_processus)
  224: {
  225:     struct_objet                *s_objet_argument;
  226: 
  227:     (*s_etat_processus).erreur_execution = d_ex;
  228: 
  229:     if ((*s_etat_processus).affichage_arguments == 'Y')
  230:     {
  231:         printf("\n  *W ");
  232: 
  233:         if ((*s_etat_processus).langue == 'F')
  234:         {
  235:             printf("(multiplie la largeur de la fenêtre graphique)\n\n");
  236:         }
  237:         else
  238:         {
  239:             printf("(multiply width of graphical window)\n\n");
  240:         }
  241: 
  242:         printf("    1: %s, %s\n", d_INT, d_REL);
  243: 
  244:         return;
  245:     }
  246:     else if ((*s_etat_processus).test_instruction == 'Y')
  247:     {
  248:         (*s_etat_processus).nombre_arguments = -1;
  249:         return;
  250:     }
  251:     
  252:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  253:     {
  254:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
  255:         {
  256:             return;
  257:         }
  258:     }
  259: 
  260:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  261:             &s_objet_argument) == d_erreur)
  262:     {
  263:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
  264:         return;
  265:     }
  266: 
  267:     if ((*s_objet_argument).type == INT)
  268:     {
  269:         if ((*((integer8 *) (*s_objet_argument).objet)) <= 0)
  270:         {
  271:             liberation(s_etat_processus, s_objet_argument);
  272: 
  273:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
  274:             return;
  275:         }
  276: 
  277:         if ((*s_etat_processus).systeme_axes == 0)
  278:         {
  279:             (*s_etat_processus).x_min *= (real8) (*((integer8 *)
  280:                     (*s_objet_argument).objet));
  281:             (*s_etat_processus).x_max *= (real8) (*((integer8 *)
  282:                     (*s_objet_argument).objet));
  283:         }
  284:         else
  285:         {
  286:             (*s_etat_processus).x2_min *= (real8) (*((integer8 *)
  287:                     (*s_objet_argument).objet));
  288:             (*s_etat_processus).x2_max *= (real8) (*((integer8 *)
  289:                     (*s_objet_argument).objet));
  290:         }
  291:     }
  292:     else if ((*s_objet_argument).type == REL)
  293:     {
  294:         if ((*((real8 *) (*s_objet_argument).objet)) <= 0)
  295:         {
  296:             liberation(s_etat_processus, s_objet_argument);
  297: 
  298:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
  299:             return;
  300:         }
  301: 
  302:         if ((*s_etat_processus).systeme_axes == 0)
  303:         {
  304:             (*s_etat_processus).x_min *= (*((real8 *)
  305:                     (*s_objet_argument).objet));
  306:             (*s_etat_processus).x_max *= (*((real8 *)
  307:                     (*s_objet_argument).objet));
  308:         }
  309:         else
  310:         {
  311:             (*s_etat_processus).x2_min *= (*((real8 *)
  312:                     (*s_objet_argument).objet));
  313:             (*s_etat_processus).x2_max *= (*((real8 *)
  314:                     (*s_objet_argument).objet));
  315:         }
  316:     }
  317:     else
  318:     {
  319:         liberation(s_etat_processus, s_objet_argument);
  320: 
  321:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
  322:         return;
  323:     }
  324: 
  325:     liberation(s_etat_processus, s_objet_argument);
  326: 
  327:     if (test_cfsf(s_etat_processus, 52) == d_faux)
  328:     {
  329:         if ((*s_etat_processus).fichiers_graphiques != NULL)
  330:         {
  331:             appel_gnuplot(s_etat_processus, 'N');
  332:         }
  333:     }
  334: 
  335:     return;
  336: }
  337: 
  338: 
  339: /*
  340: ================================================================================
  341:   Fonction '*h'
  342: ================================================================================
  343:   Entrées : pointeur sur une structure struct_processus
  344: --------------------------------------------------------------------------------
  345:   Sorties :
  346: --------------------------------------------------------------------------------
  347:   Effets de bord : néant
  348: ================================================================================
  349: */
  350: 
  351: void
  352: instruction_star_h(struct_processus *s_etat_processus)
  353: {
  354:     struct_objet                *s_objet_argument;
  355: 
  356:     (*s_etat_processus).erreur_execution = d_ex;
  357: 
  358:     if ((*s_etat_processus).affichage_arguments == 'Y')
  359:     {
  360:         printf("\n  *H ");
  361: 
  362:         if ((*s_etat_processus).langue == 'F')
  363:         {
  364:             printf("(multiplie la hauteur de la fenêtre graphique)\n\n");
  365:         }
  366:         else
  367:         {
  368:             printf("(multiply heigh of graphical window)\n\n");
  369:         }
  370: 
  371:         printf("    1: %s, %s\n", d_INT, d_REL);
  372: 
  373:         return;
  374:     }
  375:     else if ((*s_etat_processus).test_instruction == 'Y')
  376:     {
  377:         (*s_etat_processus).nombre_arguments = -1;
  378:         return;
  379:     }
  380:     
  381:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  382:     {
  383:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
  384:         {
  385:             return;
  386:         }
  387:     }
  388: 
  389:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  390:             &s_objet_argument) == d_erreur)
  391:     {
  392:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
  393:         return;
  394:     }
  395: 
  396:     if ((*s_objet_argument).type == INT)
  397:     {
  398:         if ((*((integer8 *) (*s_objet_argument).objet)) <= 0)
  399:         {
  400:             liberation(s_etat_processus, s_objet_argument);
  401: 
  402:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
  403:             return;
  404:         }
  405: 
  406:         if ((*s_etat_processus).systeme_axes == 0)
  407:         {
  408:             (*s_etat_processus).y_min *= (real8) (*((integer8 *)
  409:                     (*s_objet_argument).objet));
  410:             (*s_etat_processus).y_max *= (real8) (*((integer8 *)
  411:                     (*s_objet_argument).objet));
  412:         }
  413:         else
  414:         {
  415:             (*s_etat_processus).y2_min *= (real8) (*((integer8 *)
  416:                     (*s_objet_argument).objet));
  417:             (*s_etat_processus).y2_max *= (real8) (*((integer8 *)
  418:                     (*s_objet_argument).objet));
  419:         }
  420:     }
  421:     else if ((*s_objet_argument).type == REL)
  422:     {
  423:         if ((*((real8 *) (*s_objet_argument).objet)) <= 0)
  424:         {
  425:             liberation(s_etat_processus, s_objet_argument);
  426: 
  427:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
  428:             return;
  429:         }
  430: 
  431:         if ((*s_etat_processus).systeme_axes == 0)
  432:         {
  433:             (*s_etat_processus).y_min *= (*((real8 *)
  434:                     (*s_objet_argument).objet));
  435:             (*s_etat_processus).y_max *= (*((real8 *)
  436:                     (*s_objet_argument).objet));
  437:         }
  438:         else
  439:         {
  440:             (*s_etat_processus).y2_min *= (*((real8 *)
  441:                     (*s_objet_argument).objet));
  442:             (*s_etat_processus).y2_max *= (*((real8 *)
  443:                     (*s_objet_argument).objet));
  444:         }
  445:     }
  446:     else
  447:     {
  448:         liberation(s_etat_processus, s_objet_argument);
  449: 
  450:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
  451:         return;
  452:     }
  453: 
  454:     liberation(s_etat_processus, s_objet_argument);
  455: 
  456:     if (test_cfsf(s_etat_processus, 52) == d_faux)
  457:     {
  458:         if ((*s_etat_processus).fichiers_graphiques != NULL)
  459:         {
  460:             appel_gnuplot(s_etat_processus, 'N');
  461:         }
  462:     }
  463: 
  464:     return;
  465: }
  466: 
  467: 
  468: /*
  469: ================================================================================
  470:   Fonction '*d'
  471: ================================================================================
  472:   Entrées : pointeur sur une structure struct_processus
  473: --------------------------------------------------------------------------------
  474:   Sorties :
  475: --------------------------------------------------------------------------------
  476:   Effets de bord : néant
  477: ================================================================================
  478: */
  479: 
  480: void
  481: instruction_star_d(struct_processus *s_etat_processus)
  482: {
  483:     struct_objet                *s_objet_argument;
  484: 
  485:     (*s_etat_processus).erreur_execution = d_ex;
  486: 
  487:     if ((*s_etat_processus).affichage_arguments == 'Y')
  488:     {
  489:         printf("\n  *D ");
  490: 
  491:         if ((*s_etat_processus).langue == 'F')
  492:         {
  493:             printf("(multiplie la profondeur de la fenêtre graphique)\n\n");
  494:         }
  495:         else
  496:         {
  497:             printf("(multiply depth of graphical window)\n\n");
  498:         }
  499: 
  500:         printf("    1: %s, %s\n", d_INT, d_REL);
  501: 
  502:         return;
  503:     }
  504:     else if ((*s_etat_processus).test_instruction == 'Y')
  505:     {
  506:         (*s_etat_processus).nombre_arguments = -1;
  507:         return;
  508:     }
  509:     
  510:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  511:     {
  512:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
  513:         {
  514:             return;
  515:         }
  516:     }
  517: 
  518:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  519:             &s_objet_argument) == d_erreur)
  520:     {
  521:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
  522:         return;
  523:     }
  524: 
  525:     if ((*s_objet_argument).type == INT)
  526:     {
  527:         if ((*((integer8 *) (*s_objet_argument).objet)) <= 0)
  528:         {
  529:             liberation(s_etat_processus, s_objet_argument);
  530: 
  531:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
  532:             return;
  533:         }
  534: 
  535:         if ((*s_etat_processus).systeme_axes == 0)
  536:         {
  537:             (*s_etat_processus).z_min *= (real8) (*((integer8 *)
  538:                     (*s_objet_argument).objet));
  539:             (*s_etat_processus).z_max *= (real8) (*((integer8 *)
  540:                     (*s_objet_argument).objet));
  541:         }
  542:         else
  543:         {
  544:             (*s_etat_processus).z2_min *= (real8) (*((integer8 *)
  545:                     (*s_objet_argument).objet));
  546:             (*s_etat_processus).z2_max *= (real8) (*((integer8 *)
  547:                     (*s_objet_argument).objet));
  548:         }
  549:     }
  550:     else if ((*s_objet_argument).type == REL)
  551:     {
  552:         if ((*((real8 *) (*s_objet_argument).objet)) <= 0)
  553:         {
  554:             liberation(s_etat_processus, s_objet_argument);
  555: 
  556:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
  557:             return;
  558:         }
  559: 
  560:         if ((*s_etat_processus).systeme_axes == 0)
  561:         {
  562:             (*s_etat_processus).z_min *= (*((real8 *)
  563:                     (*s_objet_argument).objet));
  564:             (*s_etat_processus).z_max *= (*((real8 *)
  565:                     (*s_objet_argument).objet));
  566:         }
  567:         else
  568:         {
  569:             (*s_etat_processus).z2_min *= (*((real8 *)
  570:                     (*s_objet_argument).objet));
  571:             (*s_etat_processus).z2_max *= (*((real8 *)
  572:                     (*s_objet_argument).objet));
  573:         }
  574:     }
  575:     else
  576:     {
  577:         liberation(s_etat_processus, s_objet_argument);
  578: 
  579:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
  580:         return;
  581:     }
  582: 
  583:     liberation(s_etat_processus, s_objet_argument);
  584: 
  585:     if (test_cfsf(s_etat_processus, 52) == d_faux)
  586:     {
  587:         if ((*s_etat_processus).fichiers_graphiques != NULL)
  588:         {
  589:             appel_gnuplot(s_etat_processus, 'N');
  590:         }
  591:     }
  592: 
  593:     return;
  594: }
  595: 
  596: /*
  597: ================================================================================
  598:   Fonction 'store'
  599: ================================================================================
  600:   Entrées : structure processus
  601: --------------------------------------------------------------------------------
  602:   Sorties :
  603: --------------------------------------------------------------------------------
  604:   Effets de bord : néant
  605: ================================================================================
  606: */
  607: 
  608: void
  609: instruction_store(struct_processus *s_etat_processus)
  610: {
  611:     file                                *fichier;
  612: 
  613:     logical1                            i45;
  614:     logical1                            i48;
  615:     logical1                            i49;
  616:     logical1                            i50;
  617: 
  618:     struct_objet                        *s_objet_argument_1;
  619:     struct_objet                        *s_objet_argument_2;
  620: 
  621:     unsigned char                       *ligne;
  622:     unsigned char                       *ligne_convertie;
  623:     unsigned char                       registre;
  624: 
  625:     (*s_etat_processus).erreur_execution = d_ex;
  626: 
  627:     if ((*s_etat_processus).affichage_arguments == 'Y')
  628:     {
  629:         printf("\n  STORE ");
  630: 
  631:         if ((*s_etat_processus).langue == 'F')
  632:         {
  633:             printf("(enregistre une variable sur disque)\n\n");
  634:         }
  635:         else
  636:         {
  637:             printf("(store a variable on disk)\n\n");
  638:         }
  639: 
  640:         printf("    2: %s, %s, %s, %s, %s, %s,\n"
  641:                 "       %s, %s, %s, %s, %s,\n"
  642:                 "       %s, %s, %s, %s, %s\n",
  643:                 d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
  644:                 d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN);
  645:         printf("    1: %s\n", d_CHN);
  646: 
  647:         return;
  648:     }
  649:     else if ((*s_etat_processus).test_instruction == 'Y')
  650:     {
  651:         (*s_etat_processus).nombre_arguments = -1;
  652:         return;
  653:     }
  654: 
  655:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  656:     {
  657:         if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
  658:         {
  659:             return;
  660:         }
  661:     }
  662: 
  663:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  664:             &s_objet_argument_1) == d_erreur)
  665:     {
  666:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
  667:         return;
  668:     }
  669: 
  670:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  671:             &s_objet_argument_2) == d_erreur)
  672:     {
  673:         liberation(s_etat_processus, s_objet_argument_1);
  674: 
  675:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
  676:         return;
  677:     }
  678: 
  679:     if (((*s_objet_argument_2).type != INT) &&
  680:             ((*s_objet_argument_2).type != REL) &&
  681:             ((*s_objet_argument_2).type != CPL) &&
  682:             ((*s_objet_argument_2).type != VIN) &&
  683:             ((*s_objet_argument_2).type != VRL) &&
  684:             ((*s_objet_argument_2).type != VCX) &&
  685:             ((*s_objet_argument_2).type != MIN) &&
  686:             ((*s_objet_argument_2).type != MRL) &&
  687:             ((*s_objet_argument_2).type != MCX) &&
  688:             ((*s_objet_argument_2).type != TBL) &&
  689:             ((*s_objet_argument_2).type != BIN) &&
  690:             ((*s_objet_argument_2).type != NOM) &&
  691:             ((*s_objet_argument_2).type != CHN) &&
  692:             ((*s_objet_argument_2).type != LST) &&
  693:             ((*s_objet_argument_2).type != ALG) &&
  694:             ((*s_objet_argument_2).type != RPN))
  695:     {
  696:         liberation(s_etat_processus, s_objet_argument_1);
  697:         liberation(s_etat_processus, s_objet_argument_2);
  698: 
  699:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
  700:         return;
  701:     }
  702: 
  703:     if ((*s_objet_argument_1).type == CHN)
  704:     {
  705:         if ((fichier = fopen((unsigned char *) (*s_objet_argument_1).objet,
  706:                 "w")) == NULL)
  707:         {
  708:             liberation(s_etat_processus, s_objet_argument_1);
  709:             liberation(s_etat_processus, s_objet_argument_2);
  710: 
  711:             (*s_etat_processus).erreur_execution = d_ex_erreur_fichier;
  712:             return;
  713:         }
  714: 
  715:         i45 = test_cfsf(s_etat_processus, 45);
  716:         i48 = test_cfsf(s_etat_processus, 48);
  717:         i49 = test_cfsf(s_etat_processus, 49);
  718:         i50 = test_cfsf(s_etat_processus, 50);
  719: 
  720:         cf(s_etat_processus, 45);
  721:         cf(s_etat_processus, 48);
  722:         cf(s_etat_processus, 49);
  723:         cf(s_etat_processus, 50);
  724: 
  725:         if (fprintf(fichier, "// RPL/2 disk variable\n") < 0)
  726:         {
  727:             (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
  728:             return;
  729:         }
  730: 
  731:         registre = (*s_etat_processus).autorisation_conversion_chaine;
  732:         (*s_etat_processus).autorisation_conversion_chaine = 'N';
  733: 
  734:         ligne = formateur(s_etat_processus, 0, s_objet_argument_2);
  735: 
  736:         if ((ligne_convertie = transliteration(s_etat_processus,
  737:                 ligne, d_locale, "UTF-8")) == NULL)
  738:         {
  739:             free(ligne);
  740: 
  741:             liberation(s_etat_processus, s_objet_argument_1);
  742:             liberation(s_etat_processus, s_objet_argument_2);
  743:             return;
  744:         }
  745: 
  746:         free(ligne);
  747:         ligne = ligne_convertie;
  748: 
  749:         (*s_etat_processus).autorisation_conversion_chaine = registre;
  750: 
  751:         if ((*s_objet_argument_2).type == CHN)
  752:         {
  753:             if (fprintf(fichier, "\"%s\"\n", ligne) < 0)
  754:             {
  755:                 (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
  756:                 return;
  757:             }
  758: 
  759:             (*s_etat_processus).autorisation_conversion_chaine = registre;
  760:         }
  761:         else
  762:         {
  763:             if (fprintf(fichier, "%s\n", ligne) < 0)
  764:             {
  765:                 (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
  766:                 return;
  767:             }
  768: 
  769:             (*s_etat_processus).autorisation_conversion_chaine = registre;
  770:         }
  771: 
  772:         free(ligne);
  773: 
  774:         if (fclose(fichier) != 0)
  775:         {
  776:             (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
  777:             return;
  778:         }
  779: 
  780:         if (i45 == d_vrai)
  781:         {
  782:             sf(s_etat_processus, 45);
  783:         }
  784:         else
  785:         {
  786:             cf(s_etat_processus, 45);
  787:         }
  788: 
  789:         if (i48 == d_vrai)
  790:         {
  791:             sf(s_etat_processus, 48);
  792:         }
  793:         else
  794:         {
  795:             cf(s_etat_processus, 48);
  796:         }
  797: 
  798:         if (i49 == d_vrai)
  799:         {
  800:             sf(s_etat_processus, 49);
  801:         }
  802:         else
  803:         {
  804:             cf(s_etat_processus, 49);
  805:         }
  806: 
  807:         if (i50 == d_vrai)
  808:         {
  809:             sf(s_etat_processus, 50);
  810:         }
  811:         else
  812:         {
  813:             cf(s_etat_processus, 50);
  814:         }
  815:     }
  816:     else
  817:     {
  818:         liberation(s_etat_processus, s_objet_argument_1);
  819:         liberation(s_etat_processus, s_objet_argument_2);
  820: 
  821:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
  822:         return;
  823:     }
  824: 
  825:     liberation(s_etat_processus, s_objet_argument_1);
  826:     liberation(s_etat_processus, s_objet_argument_2);
  827: 
  828:     return;
  829: }
  830: 
  831: 
  832: /*
  833: ================================================================================
  834:   Fonction 'stws'
  835: ================================================================================
  836:   Entrées : structure processus
  837: --------------------------------------------------------------------------------
  838:   Sorties :
  839: --------------------------------------------------------------------------------
  840:   Effets de bord : néant
  841: ================================================================================
  842: */
  843: 
  844: void
  845: instruction_stws(struct_processus *s_etat_processus)
  846: {
  847:     logical1                    i43;
  848:     logical1                    i44;
  849: 
  850:     struct_objet                *s_objet_argument;
  851:     struct_objet                *s_objet_binaire;
  852: 
  853:     unsigned char               *valeur_binaire;
  854: 
  855:     unsigned long               i;
  856:     unsigned long               j;
  857: 
  858:     (*s_etat_processus).erreur_execution = d_ex;
  859: 
  860:     if ((*s_etat_processus).affichage_arguments == 'Y')
  861:     {
  862:         printf("\n  STWS ");
  863: 
  864:         if ((*s_etat_processus).langue == 'F')
  865:         {
  866:             printf("(affectation de la longueur des entiers binaires)\n\n");
  867:         }
  868:         else
  869:         {
  870:             printf("(set the length of the binary integers)\n\n");
  871:         }
  872: 
  873:         printf("    1: %s\n", d_INT);
  874: 
  875:         return;
  876:     }
  877:     else if ((*s_etat_processus).test_instruction == 'Y')
  878:     {
  879:         (*s_etat_processus).nombre_arguments = -1;
  880:         return;
  881:     }
  882: 
  883:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  884:     {
  885:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
  886:         {
  887:             return;
  888:         }
  889:     }
  890: 
  891:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  892:             &s_objet_argument) == d_erreur)
  893:     {
  894:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
  895:         return;
  896:     }
  897: 
  898:     if ((*s_objet_argument).type == INT)
  899:     {
  900:         if (((*((integer8 *) (*s_objet_argument).objet)) < 1 ) ||
  901:                 ((*((integer8 *) (*s_objet_argument).objet)) > 64))
  902:         {
  903:             liberation(s_etat_processus, s_objet_argument);
  904: 
  905:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
  906:             return;
  907:         }
  908: 
  909:         if ((s_objet_binaire = allocation(s_etat_processus, BIN)) == NULL)
  910:         {
  911:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  912:             return;
  913:         }
  914: 
  915:         (*((logical8 *) (*s_objet_binaire).objet)) = (*((integer8 *)
  916:                 (*s_objet_argument).objet)) - 1;
  917: 
  918:         i43 = test_cfsf(s_etat_processus, 43);
  919:         i44 = test_cfsf(s_etat_processus, 44);
  920: 
  921:         sf(s_etat_processus, 44);
  922:         cf(s_etat_processus, 43);
  923: 
  924:         valeur_binaire = formateur(s_etat_processus, 0, s_objet_binaire);
  925: 
  926:         liberation(s_etat_processus, s_objet_binaire);
  927: 
  928:         if (i43 == d_vrai)
  929:         {
  930:             sf(s_etat_processus, 43);
  931:         }
  932:         else
  933:         {
  934:             cf(s_etat_processus, 43);
  935:         }
  936: 
  937:         if (i44 == d_vrai)
  938:         {
  939:             sf(s_etat_processus, 44);
  940:         }
  941:         else
  942:         {
  943:             cf(s_etat_processus, 44);
  944:         }
  945: 
  946:         for(j = 37, i = strlen(valeur_binaire) - 2; i >= 2; i--)
  947:         {
  948:             if (valeur_binaire[i] == '0')
  949:             {
  950:                 cf(s_etat_processus, j++);
  951:             }
  952:             else
  953:             {
  954:                 sf(s_etat_processus, j++);
  955:             }
  956:         }
  957: 
  958:         for(; j <= 42; cf(s_etat_processus, j++));
  959: 
  960:         free(valeur_binaire);
  961:     }
  962:     else
  963:     {
  964:         liberation(s_etat_processus, s_objet_argument);
  965: 
  966:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
  967:         return;
  968:     }
  969: 
  970:     liberation(s_etat_processus, s_objet_argument);
  971: 
  972:     return;
  973: }
  974: 
  975: 
  976: /*
  977: ================================================================================
  978:   Fonction 'sl'
  979: ================================================================================
  980:   Entrées : pointeur sur une structure struct_processus
  981: --------------------------------------------------------------------------------
  982:   Sorties :
  983: --------------------------------------------------------------------------------
  984:   Effets de bord : néant
  985: ================================================================================
  986: */
  987: 
  988: void
  989: instruction_sl(struct_processus *s_etat_processus)
  990: {
  991:     logical8                            masque;
  992:     logical8                            tampon;
  993: 
  994:     struct_objet                        *s_copie;
  995:     struct_objet                        *s_objet;
  996: 
  997:     unsigned long                       i;
  998:     unsigned long                       j;
  999:     unsigned long                       longueur;
 1000: 
 1001:     (*s_etat_processus).erreur_execution = d_ex;
 1002: 
 1003:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1004:     {
 1005:         printf("\n  SL ");
 1006: 
 1007:         if ((*s_etat_processus).langue == 'F')
 1008:         {
 1009:             printf("(déplacement à gauche)\n\n");
 1010:         }
 1011:         else
 1012:         {
 1013:             printf("(shift left)\n\n");
 1014:         }
 1015: 
 1016:         printf("    1: %s\n", d_BIN);
 1017:         printf("->  1: %s\n", d_BIN);
 1018: 
 1019:         return;
 1020:     }
 1021:     else if ((*s_etat_processus).test_instruction == 'Y')
 1022:     {
 1023:         (*s_etat_processus).nombre_arguments = -1;
 1024:         return;
 1025:     }
 1026: 
 1027:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1028:     {
 1029:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 1030:         {
 1031:             return;
 1032:         }
 1033:     }
 1034: 
 1035:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1036:             &s_objet) == d_erreur)
 1037:     {
 1038:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1039:         return;
 1040:     }
 1041: 
 1042:     if ((*s_objet).type == BIN)
 1043:     {
 1044:         if ((s_copie = copie_objet(s_etat_processus, s_objet, 'O')) == NULL)
 1045:         {
 1046:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1047:             return;
 1048:         }
 1049: 
 1050:         longueur = 1;
 1051:         j = 1;
 1052: 
 1053:         for(i = 37; i <= 42; i++)
 1054:         {
 1055:             longueur += (test_cfsf(s_etat_processus, (unsigned char) i)
 1056:                     == d_vrai) ? j : 0;
 1057:             j *= 2;
 1058:         }
 1059: 
 1060:         tampon = (*((logical8 *) (*s_copie).objet));
 1061:         tampon <<= 1;
 1062: 
 1063:         for(masque = 0, i = 1; i < longueur; i++)
 1064:         {
 1065:             masque <<= 1;
 1066:             masque |= (logical8) 1;
 1067:         }
 1068: 
 1069:         masque <<= 1;
 1070:         tampon &= masque;
 1071:         (*((logical8 *) (*s_copie).objet)) = tampon;
 1072: 
 1073:         if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1074:                 s_copie) == d_erreur)
 1075:         {
 1076:             return;
 1077:         }
 1078:     }
 1079:     else
 1080:     {
 1081:         liberation(s_etat_processus, s_objet);
 1082: 
 1083:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 1084:         return;
 1085:     }
 1086: 
 1087:     liberation(s_etat_processus, s_objet);
 1088: 
 1089:     return;
 1090: }
 1091: 
 1092: 
 1093: /*
 1094: ================================================================================
 1095:   Fonction 'slb'
 1096: ================================================================================
 1097:   Entrées : pointeur sur une structure struct_processus
 1098: --------------------------------------------------------------------------------
 1099:   Sorties :
 1100: --------------------------------------------------------------------------------
 1101:   Effets de bord : néant
 1102: ================================================================================
 1103: */
 1104: 
 1105: void
 1106: instruction_slb(struct_processus *s_etat_processus)
 1107: {
 1108:     struct_liste_chainee    *l_base_pile;
 1109: 
 1110:     unsigned long           i;
 1111: 
 1112:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1113:     {
 1114:         printf("\n  SLB ");
 1115: 
 1116:         if ((*s_etat_processus).langue == 'F')
 1117:         {
 1118:             printf("(déplacement d'un octet à gauche)\n\n");
 1119:         }
 1120:         else
 1121:         {
 1122:             printf("(shift left byte)\n\n");
 1123:         }
 1124: 
 1125:         printf("    1: %s\n", d_BIN);
 1126:         printf("->  1: %s\n", d_BIN);
 1127: 
 1128:         return;
 1129:     }
 1130:     else if ((*s_etat_processus).test_instruction == 'Y')
 1131:     {
 1132:         (*s_etat_processus).nombre_arguments = -1;
 1133:         return;
 1134:     }
 1135: 
 1136:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1137:     {
 1138:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 1139:         {
 1140:             return;
 1141:         }
 1142:     }
 1143: 
 1144:     l_base_pile = (*s_etat_processus).l_base_pile_last;
 1145:     (*s_etat_processus).l_base_pile_last = NULL;
 1146: 
 1147:     for(i = 0; i < 8; i++)
 1148:     {
 1149:         instruction_sl(s_etat_processus);
 1150: 
 1151:         if (((*s_etat_processus).erreur_systeme != d_es) ||
 1152:                 ((*s_etat_processus).erreur_execution != d_ex))
 1153:         {
 1154:             break;
 1155:         }
 1156:     }
 1157: 
 1158:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1159:     {
 1160:         if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
 1161:         {
 1162:             return;
 1163:         }
 1164:     }
 1165: 
 1166:     (*s_etat_processus).l_base_pile_last = l_base_pile;
 1167:     return;
 1168: }
 1169: 
 1170: 
 1171: /*
 1172: ================================================================================
 1173:   Fonction 'sr'
 1174: ================================================================================
 1175:   Entrées : pointeur sur une structure struct_processus
 1176: --------------------------------------------------------------------------------
 1177:   Sorties :
 1178: --------------------------------------------------------------------------------
 1179:   Effets de bord : néant
 1180: ================================================================================
 1181: */
 1182: 
 1183: void
 1184: instruction_sr(struct_processus *s_etat_processus)
 1185: {
 1186:     logical8                            masque;
 1187:     logical8                            tampon;
 1188: 
 1189:     struct_objet                        *s_copie;
 1190:     struct_objet                        *s_objet;
 1191: 
 1192:     unsigned long                       i;
 1193:     unsigned long                       j;
 1194:     unsigned long                       longueur;
 1195: 
 1196:     (*s_etat_processus).erreur_execution = d_ex;
 1197: 
 1198:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1199:     {
 1200:         printf("\n  SR ");
 1201: 
 1202:         if ((*s_etat_processus).langue == 'F')
 1203:         {
 1204:             printf("(déplacement à droite)\n\n");
 1205:         }
 1206:         else
 1207:         {
 1208:             printf("(shift right)\n\n");
 1209:         }
 1210: 
 1211:         printf("    1: %s\n", d_BIN);
 1212:         printf("->  1: %s\n", d_BIN);
 1213: 
 1214:         return;
 1215:     }
 1216:     else if ((*s_etat_processus).test_instruction == 'Y')
 1217:     {
 1218:         (*s_etat_processus).nombre_arguments = -1;
 1219:         return;
 1220:     }
 1221: 
 1222:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1223:     {
 1224:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 1225:         {
 1226:             return;
 1227:         }
 1228:     }
 1229: 
 1230:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1231:             &s_objet) == d_erreur)
 1232:     {
 1233:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1234:         return;
 1235:     }
 1236: 
 1237:     if ((*s_objet).type == BIN)
 1238:     {
 1239:         if ((s_copie = copie_objet(s_etat_processus, s_objet, 'O')) == NULL)
 1240:         {
 1241:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1242:             return;
 1243:         }
 1244: 
 1245:         longueur = 1;
 1246:         j = 1;
 1247: 
 1248:         for(i = 37; i <= 42; i++)
 1249:         {
 1250:             longueur += (test_cfsf(s_etat_processus, (unsigned char) i)
 1251:                     == d_vrai) ? j : 0;
 1252:             j *= 2;
 1253:         }
 1254: 
 1255:         tampon = (*((logical8 *) (*s_copie).objet));
 1256:         tampon >>= 1;
 1257: 
 1258:         for(masque = 0, i = 0; i < longueur; i++)
 1259:         {
 1260:             masque <<= 1;
 1261:             masque |= 1;
 1262:         }
 1263: 
 1264:         tampon &= masque;
 1265:         (*((logical8 *) (*s_copie).objet)) = tampon;
 1266: 
 1267:         if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1268:                 s_copie) == d_erreur)
 1269:         {
 1270:             return;
 1271:         }
 1272:     }
 1273:     else
 1274:     {
 1275:         liberation(s_etat_processus, s_objet);
 1276: 
 1277:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 1278:         return;
 1279:     }
 1280: 
 1281:     liberation(s_etat_processus, s_objet);
 1282: 
 1283:     return;
 1284: }
 1285: 
 1286: 
 1287: /*
 1288: ================================================================================
 1289:   Fonction 'srb'
 1290: ================================================================================
 1291:   Entrées : pointeur sur une structure struct_processus
 1292: --------------------------------------------------------------------------------
 1293:   Sorties :
 1294: --------------------------------------------------------------------------------
 1295:   Effets de bord : néant
 1296: ================================================================================
 1297: */
 1298: 
 1299: void
 1300: instruction_srb(struct_processus *s_etat_processus)
 1301: {
 1302:     struct_liste_chainee    *l_base_pile;
 1303: 
 1304:     unsigned long           i;
 1305: 
 1306:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1307:     {
 1308:         printf("\n  SRB ");
 1309: 
 1310:         if ((*s_etat_processus).langue == 'F')
 1311:         {
 1312:             printf("(déplacement d'un octet à droite)\n\n");
 1313:         }
 1314:         else
 1315:         {
 1316:             printf("(shift right byte)\n\n");
 1317:         }
 1318: 
 1319:         printf("    1: %s\n", d_BIN);
 1320:         printf("->  1: %s\n", d_BIN);
 1321: 
 1322:         return;
 1323:     }
 1324:     else if ((*s_etat_processus).test_instruction == 'Y')
 1325:     {
 1326:         (*s_etat_processus).nombre_arguments = -1;
 1327:         return;
 1328:     }
 1329: 
 1330:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1331:     {
 1332:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 1333:         {
 1334:             return;
 1335:         }
 1336:     }
 1337: 
 1338:     l_base_pile = (*s_etat_processus).l_base_pile_last;
 1339:     (*s_etat_processus).l_base_pile_last = NULL;
 1340: 
 1341:     for(i = 0; i < 8; i++)
 1342:     {
 1343:         instruction_sr(s_etat_processus);
 1344: 
 1345:         if (((*s_etat_processus).erreur_systeme != d_es) ||
 1346:                 ((*s_etat_processus).erreur_execution != d_ex))
 1347:         {
 1348:             break;
 1349:         }
 1350:     }
 1351: 
 1352:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1353:     {
 1354:         if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
 1355:         {
 1356:             return;
 1357:         }
 1358:     }
 1359: 
 1360:     (*s_etat_processus).l_base_pile_last = l_base_pile;
 1361:     return;
 1362: }
 1363: 
 1364: 
 1365: /*
 1366: ================================================================================
 1367:   Fonction 'scatter' (passe en mode d'affichage échantilloné)
 1368: ================================================================================
 1369:   Entrées : structure processus
 1370: --------------------------------------------------------------------------------
 1371:   Sorties :
 1372: --------------------------------------------------------------------------------
 1373:   Effets de bord : néant
 1374: ================================================================================
 1375: */
 1376: 
 1377: void
 1378: instruction_scatter(struct_processus *s_etat_processus)
 1379: {
 1380:     (*s_etat_processus).erreur_execution = d_ex;
 1381: 
 1382:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1383:     {
 1384:         printf("\n  SCATTER ");
 1385: 
 1386:         if ((*s_etat_processus).langue == 'F')
 1387:         {
 1388:             printf("(graphique statistique de type nuage de points)\n\n");
 1389:             printf("  Aucun argument\n");
 1390:         }
 1391:         else
 1392:         {
 1393:             printf("(scatter statistical graphic)\n\n");
 1394:             printf("  No argument\n");
 1395:         }
 1396: 
 1397:         return;
 1398:     }
 1399:     else if ((*s_etat_processus).test_instruction == 'Y')
 1400:     {
 1401:         (*s_etat_processus).nombre_arguments = -1;
 1402:         return;
 1403:     }
 1404: 
 1405:     strcpy((*s_etat_processus).type_trace_sigma, "POINTS");
 1406: 
 1407:     return;
 1408: }
 1409: 
 1410: 
 1411: /*
 1412: ================================================================================
 1413:   Fonction '*s' (modifie les échelles verticale et horizontale)
 1414: ================================================================================
 1415:   Entrées : structure processus
 1416: --------------------------------------------------------------------------------
 1417:   Sorties :
 1418: --------------------------------------------------------------------------------
 1419:   Effets de bord : néant
 1420: ================================================================================
 1421: */
 1422: 
 1423: void
 1424: instruction_star_s(struct_processus *s_etat_processus)
 1425: {
 1426:     struct_objet                *s_objet_argument;
 1427: 
 1428:     (*s_etat_processus).erreur_execution = d_ex;
 1429: 
 1430:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1431:     {
 1432:         printf("\n  *S ");
 1433: 
 1434:         if ((*s_etat_processus).langue == 'F')
 1435:         {
 1436:             printf("(multiplie les dimensions de la fenêtre graphique)\n\n");
 1437:         }
 1438:         else
 1439:         {
 1440:             printf("()\n\n");
 1441:         }
 1442: 
 1443:         printf("    1: %s, %s\n", d_INT, d_REL);
 1444: 
 1445:         return;
 1446:     }
 1447:     else if ((*s_etat_processus).test_instruction == 'Y')
 1448:     {
 1449:         (*s_etat_processus).nombre_arguments = -1;
 1450:         return;
 1451:     }
 1452:     
 1453:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1454:     {
 1455:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 1456:         {
 1457:             return;
 1458:         }
 1459:     }
 1460: 
 1461:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1462:             &s_objet_argument) == d_erreur)
 1463:     {
 1464:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1465:         return;
 1466:     }
 1467: 
 1468:     if ((*s_objet_argument).type == INT)
 1469:     {
 1470:         if ((*((integer8 *) (*s_objet_argument).objet)) <= 0)
 1471:         {
 1472:             liberation(s_etat_processus, s_objet_argument);
 1473: 
 1474:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
 1475:             return;
 1476:         }
 1477: 
 1478:         if ((*s_etat_processus).systeme_axes == 0)
 1479:         {
 1480:             (*s_etat_processus).x_min *= (real8) (*((integer8 *)
 1481:                     (*s_objet_argument).objet));
 1482:             (*s_etat_processus).x_max *= (real8) (*((integer8 *)
 1483:                     (*s_objet_argument).objet));
 1484:             (*s_etat_processus).y_min *= (real8) (*((integer8 *)
 1485:                     (*s_objet_argument).objet));
 1486:             (*s_etat_processus).y_max *= (real8) (*((integer8 *)
 1487:                     (*s_objet_argument).objet));
 1488:             (*s_etat_processus).z_min *= (real8) (*((integer8 *)
 1489:                     (*s_objet_argument).objet));
 1490:             (*s_etat_processus).z_max *= (real8) (*((integer8 *)
 1491:                     (*s_objet_argument).objet));
 1492:         }
 1493:         else
 1494:         {
 1495:             (*s_etat_processus).x2_min *= (real8) (*((integer8 *)
 1496:                     (*s_objet_argument).objet));
 1497:             (*s_etat_processus).x2_max *= (real8) (*((integer8 *)
 1498:                     (*s_objet_argument).objet));
 1499:             (*s_etat_processus).y2_min *= (real8) (*((integer8 *)
 1500:                     (*s_objet_argument).objet));
 1501:             (*s_etat_processus).y2_max *= (real8) (*((integer8 *)
 1502:                     (*s_objet_argument).objet));
 1503:             (*s_etat_processus).z2_min *= (real8) (*((integer8 *)
 1504:                     (*s_objet_argument).objet));
 1505:             (*s_etat_processus).z2_max *= (real8) (*((integer8 *)
 1506:                     (*s_objet_argument).objet));
 1507:         }
 1508:     }
 1509:     else if ((*s_objet_argument).type == REL)
 1510:     {
 1511:         if ((*((real8 *) (*s_objet_argument).objet)) <= 0)
 1512:         {
 1513:             liberation(s_etat_processus, s_objet_argument);
 1514: 
 1515:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
 1516:             return;
 1517:         }
 1518: 
 1519:         if ((*s_etat_processus).systeme_axes == 0)
 1520:         {
 1521:             (*s_etat_processus).x_min *= (*((real8 *)
 1522:                     (*s_objet_argument).objet));
 1523:             (*s_etat_processus).x_max *= (*((real8 *)
 1524:                     (*s_objet_argument).objet));
 1525:             (*s_etat_processus).y_min *= (*((real8 *)
 1526:                     (*s_objet_argument).objet));
 1527:             (*s_etat_processus).y_max *= (*((real8 *)
 1528:                     (*s_objet_argument).objet));
 1529:             (*s_etat_processus).z_min *= (*((real8 *)
 1530:                     (*s_objet_argument).objet));
 1531:             (*s_etat_processus).z_max *= (*((real8 *)
 1532:                     (*s_objet_argument).objet));
 1533:         }
 1534:         else
 1535:         {
 1536:             (*s_etat_processus).x2_min *= (*((real8 *)
 1537:                     (*s_objet_argument).objet));
 1538:             (*s_etat_processus).x2_max *= (*((real8 *)
 1539:                     (*s_objet_argument).objet));
 1540:             (*s_etat_processus).y2_min *= (*((real8 *)
 1541:                     (*s_objet_argument).objet));
 1542:             (*s_etat_processus).y2_max *= (*((real8 *)
 1543:                     (*s_objet_argument).objet));
 1544:             (*s_etat_processus).z2_min *= (*((real8 *)
 1545:                     (*s_objet_argument).objet));
 1546:             (*s_etat_processus).z2_max *= (*((real8 *)
 1547:                     (*s_objet_argument).objet));
 1548:         }
 1549:     }
 1550:     else
 1551:     {
 1552:         liberation(s_etat_processus, s_objet_argument);
 1553: 
 1554:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 1555:         return;
 1556:     }
 1557: 
 1558:     liberation(s_etat_processus, s_objet_argument);
 1559: 
 1560:     if (test_cfsf(s_etat_processus, 52) == d_faux)
 1561:     {
 1562:         if ((*s_etat_processus).fichiers_graphiques != NULL)
 1563:         {
 1564:             appel_gnuplot(s_etat_processus, 'N');
 1565:         }
 1566:     }
 1567: 
 1568:     return;
 1569: }
 1570: 
 1571: 
 1572: /*
 1573: ================================================================================
 1574:   Fonction 'stos'
 1575: ================================================================================
 1576:   Entrées : structure processus
 1577: --------------------------------------------------------------------------------
 1578:   Sorties :
 1579: --------------------------------------------------------------------------------
 1580:   Effets de bord : néant
 1581: ================================================================================
 1582: */
 1583: 
 1584: void
 1585: instruction_stos(struct_processus *s_etat_processus)
 1586: {
 1587:     logical1                            presence_variable;
 1588: 
 1589:     long                                i;
 1590: 
 1591:     struct_objet                        *s_objet;
 1592: 
 1593:     struct_variable                     s_variable;
 1594: 
 1595:     (*s_etat_processus).erreur_execution = d_ex;
 1596: 
 1597:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1598:     {
 1599:         printf("\n  STOS ");
 1600: 
 1601:         if ((*s_etat_processus).langue == 'F')
 1602:         {
 1603:             printf("(affectation de la variable %s)\n\n", ds_sdat);
 1604:         }
 1605:         else
 1606:         {
 1607:             printf("(store %s variable)\n\n", ds_sdat);
 1608:         }
 1609: 
 1610:         printf("    1: %s, %s, %s, %s, %s, %s,\n"
 1611:                 "       %s, %s, %s, %s, %s,\n"
 1612:                 "       %s, %s, %s, %s, %s,\n"
 1613:                 "       %s\n",
 1614:                 d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
 1615:                 d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
 1616: 
 1617:         return;
 1618:     }
 1619:     else if ((*s_etat_processus).test_instruction == 'Y')
 1620:     {
 1621:         (*s_etat_processus).nombre_arguments = -1;
 1622:         return;
 1623:     }
 1624: 
 1625:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1626:     {
 1627:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 1628:         {
 1629:             return;
 1630:         }
 1631:     }
 1632: 
 1633:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1634:             &s_objet) == d_erreur)
 1635:     {
 1636:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1637:         return;
 1638:     }
 1639: 
 1640:     if (recherche_variable(s_etat_processus, ds_sdat) == d_vrai)
 1641:     {
 1642:         /*
 1643:          * La variable préexiste. Il faut tester si celle-ci est globale
 1644:          * (de niveau 1).
 1645:          */
 1646: 
 1647:         i = (*s_etat_processus).position_variable_courante;
 1648:         presence_variable = d_faux;
 1649: 
 1650:         while(i >= 0)
 1651:         {
 1652:             if ((strcmp((*s_etat_processus).s_liste_variables[i].nom, ds_sdat)
 1653:                     == 0) && ((*s_etat_processus).s_liste_variables[i]
 1654:                     .niveau == 1))
 1655:             {
 1656:                 presence_variable = d_vrai;
 1657:                 break;
 1658:             }
 1659:              i--;
 1660:         }
 1661: 
 1662:         (*s_etat_processus).position_variable_courante = i;
 1663: 
 1664:         if (presence_variable == d_vrai)
 1665:         {
 1666:             if ((*s_etat_processus).s_liste_variables[(*s_etat_processus)
 1667:                     .position_variable_courante].variable_verrouillee ==
 1668:                     d_vrai)
 1669:             {
 1670:                 liberation(s_etat_processus, s_objet);
 1671: 
 1672:                 (*s_etat_processus).erreur_execution =
 1673:                         d_ex_variable_verrouillee;
 1674:                 return;
 1675:             }
 1676: 
 1677:             if ((*s_etat_processus).s_liste_variables[i].objet == NULL)
 1678:             {
 1679:                 liberation(s_etat_processus, s_objet);
 1680: 
 1681:                 (*s_etat_processus).erreur_execution = d_ex_variable_partagee;
 1682:                 return;
 1683:             }
 1684: 
 1685:             liberation(s_etat_processus,
 1686:                     (*s_etat_processus).s_liste_variables[(*s_etat_processus)
 1687:                     .position_variable_courante].objet);
 1688: 
 1689:             (*s_etat_processus).s_liste_variables[(*s_etat_processus)
 1690:                     .position_variable_courante].objet = s_objet;
 1691:         }
 1692:         else
 1693:         {
 1694:             if ((s_variable.nom = malloc(6 * sizeof(unsigned char))) == NULL)
 1695:             {
 1696:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1697:                 return;
 1698:             }
 1699: 
 1700:             strcpy(s_variable.nom, ds_sdat);
 1701:             s_variable.niveau = 1;
 1702: 
 1703:             /*
 1704:              * Le niveau 0 correspond aux définitions. Les variables
 1705:              * commencent à 1 car elles sont toujours incluses dans
 1706:              * une définition.
 1707:              */
 1708: 
 1709:             s_variable.objet = s_objet;
 1710: 
 1711:             if (creation_variable(s_etat_processus, &s_variable, 'V', 'P')
 1712:                     == d_erreur)
 1713:             {
 1714:                 return;
 1715:             }
 1716:         }
 1717:     }
 1718:     else
 1719:     {
 1720:         /*
 1721:          * La variable n'existe pas et on crée une variable globale.
 1722:          */
 1723: 
 1724:         if ((s_variable.nom = malloc(6 * sizeof(unsigned char))) == NULL)
 1725:         {
 1726:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1727:             return;
 1728:         }
 1729: 
 1730:         strcpy(s_variable.nom, ds_sdat);
 1731:         s_variable.niveau = 1;
 1732: 
 1733:         /*
 1734:          * Le niveau 0 correspond aux définitions. Les variables
 1735:          * commencent à 1 car elles sont toujours incluses dans
 1736:          * une définition.
 1737:          */
 1738: 
 1739:         s_variable.objet = s_objet;
 1740: 
 1741:         if (creation_variable(s_etat_processus, &s_variable, 'V', 'P')
 1742:                 == d_erreur)
 1743:         {
 1744:             return;
 1745:         }
 1746: 
 1747:         (*s_etat_processus).erreur_systeme = d_es;
 1748:     }
 1749: 
 1750:     return;
 1751: }
 1752: 
 1753: // vim: ts=4

CVSweb interface <joel.bertrand@systella.fr>