File:  [local] / rpl / src / instructions_s4.c
Revision 1.3: download - view: text, annotated - select for diffs - revision graph
Wed Feb 10 10:14:24 2010 UTC (14 years, 2 months ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_0_11, HEAD
Branchement vers 4.0.11

    1: /*
    2: ================================================================================
    3:   RPL/2 (R) version 4.0.11
    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 '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                            i49;
  615:     logical1                            i50;
  616: 
  617:     struct_objet                        *s_objet_argument_1;
  618:     struct_objet                        *s_objet_argument_2;
  619: 
  620:     unsigned char                       *ligne;
  621: 
  622:     (*s_etat_processus).erreur_execution = d_ex;
  623: 
  624:     if ((*s_etat_processus).affichage_arguments == 'Y')
  625:     {
  626:         printf("\n  STORE ");
  627: 
  628:         if ((*s_etat_processus).langue == 'F')
  629:         {
  630:             printf("(enregistre une variable sur disque)\n\n");
  631:         }
  632:         else
  633:         {
  634:             printf("(store a variable on disk)\n\n");
  635:         }
  636: 
  637:         printf("    2: %s, %s, %s, %s, %s, %s,\n"
  638:                 "       %s, %s, %s, %s, %s,\n"
  639:                 "       %s, %s, %s, %s, %s\n",
  640:                 d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
  641:                 d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN);
  642:         printf("    1: %s\n", d_CHN);
  643: 
  644:         return;
  645:     }
  646:     else if ((*s_etat_processus).test_instruction == 'Y')
  647:     {
  648:         (*s_etat_processus).nombre_arguments = -1;
  649:         return;
  650:     }
  651: 
  652:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  653:     {
  654:         if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
  655:         {
  656:             return;
  657:         }
  658:     }
  659: 
  660:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  661:             &s_objet_argument_1) == d_erreur)
  662:     {
  663:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
  664:         return;
  665:     }
  666: 
  667:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  668:             &s_objet_argument_2) == d_erreur)
  669:     {
  670:         liberation(s_etat_processus, s_objet_argument_1);
  671: 
  672:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
  673:         return;
  674:     }
  675: 
  676:     if (((*s_objet_argument_2).type != INT) &&
  677:             ((*s_objet_argument_2).type != REL) &&
  678:             ((*s_objet_argument_2).type != CPL) &&
  679:             ((*s_objet_argument_2).type != VIN) &&
  680:             ((*s_objet_argument_2).type != VRL) &&
  681:             ((*s_objet_argument_2).type != VCX) &&
  682:             ((*s_objet_argument_2).type != MIN) &&
  683:             ((*s_objet_argument_2).type != MRL) &&
  684:             ((*s_objet_argument_2).type != MCX) &&
  685:             ((*s_objet_argument_2).type != TBL) &&
  686:             ((*s_objet_argument_2).type != BIN) &&
  687:             ((*s_objet_argument_2).type != NOM) &&
  688:             ((*s_objet_argument_2).type != CHN) &&
  689:             ((*s_objet_argument_2).type != LST) &&
  690:             ((*s_objet_argument_2).type != ALG) &&
  691:             ((*s_objet_argument_2).type != RPN))
  692:     {
  693:         liberation(s_etat_processus, s_objet_argument_1);
  694:         liberation(s_etat_processus, s_objet_argument_2);
  695: 
  696:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
  697:         return;
  698:     }
  699: 
  700:     if ((*s_objet_argument_1).type == CHN)
  701:     {
  702:         if ((fichier = fopen((unsigned char *) (*s_objet_argument_1).objet,
  703:                 "w")) == NULL)
  704:         {
  705:             liberation(s_etat_processus, s_objet_argument_1);
  706:             liberation(s_etat_processus, s_objet_argument_2);
  707: 
  708:             (*s_etat_processus).erreur_execution = d_ex_erreur_fichier;
  709:             return;
  710:         }
  711: 
  712:         i45 = test_cfsf(s_etat_processus, 45);
  713:         i49 = test_cfsf(s_etat_processus, 49);
  714:         i50 = test_cfsf(s_etat_processus, 50);
  715: 
  716:         cf(s_etat_processus, 45);
  717:         cf(s_etat_processus, 49);
  718:         cf(s_etat_processus, 50);
  719: 
  720:         if (fprintf(fichier, "// RPL/2 disk variable\n") < 0)
  721:         {
  722:             (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
  723:             return;
  724:         }
  725: 
  726:         if ((*s_objet_argument_2).type == CHN)
  727:         {
  728:             if (fprintf(fichier, "\"%s\"\n", ligne = formateur(s_etat_processus,
  729:                     0, s_objet_argument_2)) < 0)
  730:             {
  731:                 (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
  732:                 return;
  733:             }
  734:         }
  735:         else
  736:         {
  737:             if (fprintf(fichier, "%s\n", ligne = formateur(s_etat_processus,
  738:                     0, s_objet_argument_2)) < 0)
  739:             {
  740:                 (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
  741:                 return;
  742:             }
  743:         }
  744: 
  745:         free(ligne);
  746: 
  747:         if (fclose(fichier) != 0)
  748:         {
  749:             (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
  750:             return;
  751:         }
  752: 
  753:         if (i45 == d_vrai)
  754:         {
  755:             sf(s_etat_processus, 45);
  756:         }
  757:         else
  758:         {
  759:             cf(s_etat_processus, 45);
  760:         }
  761: 
  762:         if (i49 == d_vrai)
  763:         {
  764:             sf(s_etat_processus, 49);
  765:         }
  766:         else
  767:         {
  768:             cf(s_etat_processus, 49);
  769:         }
  770: 
  771:         if (i50 == d_vrai)
  772:         {
  773:             sf(s_etat_processus, 50);
  774:         }
  775:         else
  776:         {
  777:             cf(s_etat_processus, 50);
  778:         }
  779:     }
  780:     else
  781:     {
  782:         liberation(s_etat_processus, s_objet_argument_1);
  783:         liberation(s_etat_processus, s_objet_argument_2);
  784: 
  785:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
  786:         return;
  787:     }
  788: 
  789:     liberation(s_etat_processus, s_objet_argument_1);
  790:     liberation(s_etat_processus, s_objet_argument_2);
  791: 
  792:     return;
  793: }
  794: 
  795: 
  796: /*
  797: ================================================================================
  798:   Fonction 'stws'
  799: ================================================================================
  800:   Entrées : structure processus
  801: --------------------------------------------------------------------------------
  802:   Sorties :
  803: --------------------------------------------------------------------------------
  804:   Effets de bord : néant
  805: ================================================================================
  806: */
  807: 
  808: void
  809: instruction_stws(struct_processus *s_etat_processus)
  810: {
  811:     logical1                    i43;
  812:     logical1                    i44;
  813: 
  814:     struct_objet                *s_objet_argument;
  815:     struct_objet                *s_objet_binaire;
  816: 
  817:     unsigned char               *valeur_binaire;
  818: 
  819:     unsigned long               i;
  820:     unsigned long               j;
  821: 
  822:     (*s_etat_processus).erreur_execution = d_ex;
  823: 
  824:     if ((*s_etat_processus).affichage_arguments == 'Y')
  825:     {
  826:         printf("\n  STWS ");
  827: 
  828:         if ((*s_etat_processus).langue == 'F')
  829:         {
  830:             printf("(affectation de la longueur des entiers binaires)\n\n");
  831:         }
  832:         else
  833:         {
  834:             printf("(set the length of the binary integers)\n\n");
  835:         }
  836: 
  837:         printf("    1: %s\n", d_INT);
  838: 
  839:         return;
  840:     }
  841:     else if ((*s_etat_processus).test_instruction == 'Y')
  842:     {
  843:         (*s_etat_processus).nombre_arguments = -1;
  844:         return;
  845:     }
  846: 
  847:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  848:     {
  849:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
  850:         {
  851:             return;
  852:         }
  853:     }
  854: 
  855:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  856:             &s_objet_argument) == d_erreur)
  857:     {
  858:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
  859:         return;
  860:     }
  861: 
  862:     if ((*s_objet_argument).type == INT)
  863:     {
  864:         if (((*((integer8 *) (*s_objet_argument).objet)) < 1 ) ||
  865:                 ((*((integer8 *) (*s_objet_argument).objet)) > 64))
  866:         {
  867:             liberation(s_etat_processus, s_objet_argument);
  868: 
  869:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
  870:             return;
  871:         }
  872: 
  873:         if ((s_objet_binaire = allocation(s_etat_processus, BIN)) == NULL)
  874:         {
  875:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  876:             return;
  877:         }
  878: 
  879:         (*((logical8 *) (*s_objet_binaire).objet)) = (*((integer8 *)
  880:                 (*s_objet_argument).objet)) - 1;
  881: 
  882:         i43 = test_cfsf(s_etat_processus, 43);
  883:         i44 = test_cfsf(s_etat_processus, 44);
  884: 
  885:         sf(s_etat_processus, 44);
  886:         cf(s_etat_processus, 43);
  887: 
  888:         valeur_binaire = formateur(s_etat_processus, 0, s_objet_binaire);
  889: 
  890:         liberation(s_etat_processus, s_objet_binaire);
  891: 
  892:         if (i43 == d_vrai)
  893:         {
  894:             sf(s_etat_processus, 43);
  895:         }
  896:         else
  897:         {
  898:             cf(s_etat_processus, 43);
  899:         }
  900: 
  901:         if (i44 == d_vrai)
  902:         {
  903:             sf(s_etat_processus, 44);
  904:         }
  905:         else
  906:         {
  907:             cf(s_etat_processus, 44);
  908:         }
  909: 
  910:         for(j = 37, i = strlen(valeur_binaire) - 2; i >= 2; i--)
  911:         {
  912:             if (valeur_binaire[i] == '0')
  913:             {
  914:                 cf(s_etat_processus, j++);
  915:             }
  916:             else
  917:             {
  918:                 sf(s_etat_processus, j++);
  919:             }
  920:         }
  921: 
  922:         for(; j <= 42; cf(s_etat_processus, j++));
  923: 
  924:         free(valeur_binaire);
  925:     }
  926:     else
  927:     {
  928:         liberation(s_etat_processus, s_objet_argument);
  929: 
  930:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
  931:         return;
  932:     }
  933: 
  934:     liberation(s_etat_processus, s_objet_argument);
  935: 
  936:     return;
  937: }
  938: 
  939: 
  940: /*
  941: ================================================================================
  942:   Fonction 'sl'
  943: ================================================================================
  944:   Entrées : pointeur sur une structure struct_processus
  945: --------------------------------------------------------------------------------
  946:   Sorties :
  947: --------------------------------------------------------------------------------
  948:   Effets de bord : néant
  949: ================================================================================
  950: */
  951: 
  952: void
  953: instruction_sl(struct_processus *s_etat_processus)
  954: {
  955:     logical8                            masque;
  956:     logical8                            tampon;
  957: 
  958:     struct_objet                        *s_copie;
  959:     struct_objet                        *s_objet;
  960: 
  961:     unsigned long                       i;
  962:     unsigned long                       j;
  963:     unsigned long                       longueur;
  964: 
  965:     (*s_etat_processus).erreur_execution = d_ex;
  966: 
  967:     if ((*s_etat_processus).affichage_arguments == 'Y')
  968:     {
  969:         printf("\n  SL ");
  970: 
  971:         if ((*s_etat_processus).langue == 'F')
  972:         {
  973:             printf("(déplacement à gauche)\n\n");
  974:         }
  975:         else
  976:         {
  977:             printf("(shift left)\n\n");
  978:         }
  979: 
  980:         printf("    1: %s\n", d_BIN);
  981:         printf("->  1: %s\n", d_BIN);
  982: 
  983:         return;
  984:     }
  985:     else if ((*s_etat_processus).test_instruction == 'Y')
  986:     {
  987:         (*s_etat_processus).nombre_arguments = -1;
  988:         return;
  989:     }
  990: 
  991:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  992:     {
  993:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
  994:         {
  995:             return;
  996:         }
  997:     }
  998: 
  999:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1000:             &s_objet) == d_erreur)
 1001:     {
 1002:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1003:         return;
 1004:     }
 1005: 
 1006:     if ((*s_objet).type == BIN)
 1007:     {
 1008:         if ((s_copie = copie_objet(s_etat_processus, s_objet, 'O')) == NULL)
 1009:         {
 1010:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1011:             return;
 1012:         }
 1013: 
 1014:         longueur = 1;
 1015:         j = 1;
 1016: 
 1017:         for(i = 37; i <= 42; i++)
 1018:         {
 1019:             longueur += (test_cfsf(s_etat_processus, (unsigned char) i)
 1020:                     == d_vrai) ? j : 0;
 1021:             j *= 2;
 1022:         }
 1023: 
 1024:         tampon = (*((logical8 *) (*s_copie).objet));
 1025:         tampon <<= 1;
 1026: 
 1027:         for(masque = 0, i = 1; i < longueur; i++)
 1028:         {
 1029:             masque <<= 1;
 1030:             masque |= (logical8) 1;
 1031:         }
 1032: 
 1033:         masque <<= 1;
 1034:         tampon &= masque;
 1035:         (*((logical8 *) (*s_copie).objet)) = tampon;
 1036: 
 1037:         if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1038:                 s_copie) == d_erreur)
 1039:         {
 1040:             return;
 1041:         }
 1042:     }
 1043:     else
 1044:     {
 1045:         liberation(s_etat_processus, s_objet);
 1046: 
 1047:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 1048:         return;
 1049:     }
 1050: 
 1051:     liberation(s_etat_processus, s_objet);
 1052: 
 1053:     return;
 1054: }
 1055: 
 1056: 
 1057: /*
 1058: ================================================================================
 1059:   Fonction 'slb'
 1060: ================================================================================
 1061:   Entrées : pointeur sur une structure struct_processus
 1062: --------------------------------------------------------------------------------
 1063:   Sorties :
 1064: --------------------------------------------------------------------------------
 1065:   Effets de bord : néant
 1066: ================================================================================
 1067: */
 1068: 
 1069: void
 1070: instruction_slb(struct_processus *s_etat_processus)
 1071: {
 1072:     struct_liste_chainee    *l_base_pile;
 1073: 
 1074:     unsigned long           i;
 1075: 
 1076:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1077:     {
 1078:         printf("\n  SLB ");
 1079: 
 1080:         if ((*s_etat_processus).langue == 'F')
 1081:         {
 1082:             printf("(déplacement d'un octet à gauche)\n\n");
 1083:         }
 1084:         else
 1085:         {
 1086:             printf("(shift left byte)\n\n");
 1087:         }
 1088: 
 1089:         printf("    1: %s\n", d_BIN);
 1090:         printf("->  1: %s\n", d_BIN);
 1091: 
 1092:         return;
 1093:     }
 1094:     else if ((*s_etat_processus).test_instruction == 'Y')
 1095:     {
 1096:         (*s_etat_processus).nombre_arguments = -1;
 1097:         return;
 1098:     }
 1099: 
 1100:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1101:     {
 1102:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 1103:         {
 1104:             return;
 1105:         }
 1106:     }
 1107: 
 1108:     l_base_pile = (*s_etat_processus).l_base_pile_last;
 1109:     (*s_etat_processus).l_base_pile_last = NULL;
 1110: 
 1111:     for(i = 0; i < 8; i++)
 1112:     {
 1113:         instruction_sl(s_etat_processus);
 1114: 
 1115:         if (((*s_etat_processus).erreur_systeme != d_es) ||
 1116:                 ((*s_etat_processus).erreur_execution != d_ex))
 1117:         {
 1118:             break;
 1119:         }
 1120:     }
 1121: 
 1122:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1123:     {
 1124:         if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
 1125:         {
 1126:             return;
 1127:         }
 1128:     }
 1129: 
 1130:     (*s_etat_processus).l_base_pile_last = l_base_pile;
 1131:     return;
 1132: }
 1133: 
 1134: 
 1135: /*
 1136: ================================================================================
 1137:   Fonction 'sr'
 1138: ================================================================================
 1139:   Entrées : pointeur sur une structure struct_processus
 1140: --------------------------------------------------------------------------------
 1141:   Sorties :
 1142: --------------------------------------------------------------------------------
 1143:   Effets de bord : néant
 1144: ================================================================================
 1145: */
 1146: 
 1147: void
 1148: instruction_sr(struct_processus *s_etat_processus)
 1149: {
 1150:     logical8                            masque;
 1151:     logical8                            tampon;
 1152: 
 1153:     struct_objet                        *s_copie;
 1154:     struct_objet                        *s_objet;
 1155: 
 1156:     unsigned long                       i;
 1157:     unsigned long                       j;
 1158:     unsigned long                       longueur;
 1159: 
 1160:     (*s_etat_processus).erreur_execution = d_ex;
 1161: 
 1162:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1163:     {
 1164:         printf("\n  SR ");
 1165: 
 1166:         if ((*s_etat_processus).langue == 'F')
 1167:         {
 1168:             printf("(déplacement à droite)\n\n");
 1169:         }
 1170:         else
 1171:         {
 1172:             printf("(shift right)\n\n");
 1173:         }
 1174: 
 1175:         printf("    1: %s\n", d_BIN);
 1176:         printf("->  1: %s\n", d_BIN);
 1177: 
 1178:         return;
 1179:     }
 1180:     else if ((*s_etat_processus).test_instruction == 'Y')
 1181:     {
 1182:         (*s_etat_processus).nombre_arguments = -1;
 1183:         return;
 1184:     }
 1185: 
 1186:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1187:     {
 1188:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 1189:         {
 1190:             return;
 1191:         }
 1192:     }
 1193: 
 1194:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1195:             &s_objet) == d_erreur)
 1196:     {
 1197:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1198:         return;
 1199:     }
 1200: 
 1201:     if ((*s_objet).type == BIN)
 1202:     {
 1203:         if ((s_copie = copie_objet(s_etat_processus, s_objet, 'O')) == NULL)
 1204:         {
 1205:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1206:             return;
 1207:         }
 1208: 
 1209:         longueur = 1;
 1210:         j = 1;
 1211: 
 1212:         for(i = 37; i <= 42; i++)
 1213:         {
 1214:             longueur += (test_cfsf(s_etat_processus, (unsigned char) i)
 1215:                     == d_vrai) ? j : 0;
 1216:             j *= 2;
 1217:         }
 1218: 
 1219:         tampon = (*((logical8 *) (*s_copie).objet));
 1220:         tampon >>= 1;
 1221: 
 1222:         for(masque = 0, i = 0; i < longueur; i++)
 1223:         {
 1224:             masque <<= 1;
 1225:             masque |= 1;
 1226:         }
 1227: 
 1228:         tampon &= masque;
 1229:         (*((logical8 *) (*s_copie).objet)) = tampon;
 1230: 
 1231:         if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1232:                 s_copie) == d_erreur)
 1233:         {
 1234:             return;
 1235:         }
 1236:     }
 1237:     else
 1238:     {
 1239:         liberation(s_etat_processus, s_objet);
 1240: 
 1241:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 1242:         return;
 1243:     }
 1244: 
 1245:     liberation(s_etat_processus, s_objet);
 1246: 
 1247:     return;
 1248: }
 1249: 
 1250: 
 1251: /*
 1252: ================================================================================
 1253:   Fonction 'srb'
 1254: ================================================================================
 1255:   Entrées : pointeur sur une structure struct_processus
 1256: --------------------------------------------------------------------------------
 1257:   Sorties :
 1258: --------------------------------------------------------------------------------
 1259:   Effets de bord : néant
 1260: ================================================================================
 1261: */
 1262: 
 1263: void
 1264: instruction_srb(struct_processus *s_etat_processus)
 1265: {
 1266:     struct_liste_chainee    *l_base_pile;
 1267: 
 1268:     unsigned long           i;
 1269: 
 1270:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1271:     {
 1272:         printf("\n  SRB ");
 1273: 
 1274:         if ((*s_etat_processus).langue == 'F')
 1275:         {
 1276:             printf("(déplacement d'un octet à droite)\n\n");
 1277:         }
 1278:         else
 1279:         {
 1280:             printf("(shift right byte)\n\n");
 1281:         }
 1282: 
 1283:         printf("    1: %s\n", d_BIN);
 1284:         printf("->  1: %s\n", d_BIN);
 1285: 
 1286:         return;
 1287:     }
 1288:     else if ((*s_etat_processus).test_instruction == 'Y')
 1289:     {
 1290:         (*s_etat_processus).nombre_arguments = -1;
 1291:         return;
 1292:     }
 1293: 
 1294:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1295:     {
 1296:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 1297:         {
 1298:             return;
 1299:         }
 1300:     }
 1301: 
 1302:     l_base_pile = (*s_etat_processus).l_base_pile_last;
 1303:     (*s_etat_processus).l_base_pile_last = NULL;
 1304: 
 1305:     for(i = 0; i < 8; i++)
 1306:     {
 1307:         instruction_sr(s_etat_processus);
 1308: 
 1309:         if (((*s_etat_processus).erreur_systeme != d_es) ||
 1310:                 ((*s_etat_processus).erreur_execution != d_ex))
 1311:         {
 1312:             break;
 1313:         }
 1314:     }
 1315: 
 1316:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1317:     {
 1318:         if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
 1319:         {
 1320:             return;
 1321:         }
 1322:     }
 1323: 
 1324:     (*s_etat_processus).l_base_pile_last = l_base_pile;
 1325:     return;
 1326: }
 1327: 
 1328: 
 1329: /*
 1330: ================================================================================
 1331:   Fonction 'scatter' (passe en mode d'affichage échantilloné)
 1332: ================================================================================
 1333:   Entrées : structure processus
 1334: --------------------------------------------------------------------------------
 1335:   Sorties :
 1336: --------------------------------------------------------------------------------
 1337:   Effets de bord : néant
 1338: ================================================================================
 1339: */
 1340: 
 1341: void
 1342: instruction_scatter(struct_processus *s_etat_processus)
 1343: {
 1344:     (*s_etat_processus).erreur_execution = d_ex;
 1345: 
 1346:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1347:     {
 1348:         printf("\n  SCATTER ");
 1349: 
 1350:         if ((*s_etat_processus).langue == 'F')
 1351:         {
 1352:             printf("(graphique statistique de type nuage de points)\n\n");
 1353:             printf("  Aucun argument\n");
 1354:         }
 1355:         else
 1356:         {
 1357:             printf("(scatter statistical graphic)\n\n");
 1358:             printf("  No argument\n");
 1359:         }
 1360: 
 1361:         return;
 1362:     }
 1363:     else if ((*s_etat_processus).test_instruction == 'Y')
 1364:     {
 1365:         (*s_etat_processus).nombre_arguments = -1;
 1366:         return;
 1367:     }
 1368: 
 1369:     strcpy((*s_etat_processus).type_trace_sigma, "POINTS");
 1370: 
 1371:     return;
 1372: }
 1373: 
 1374: 
 1375: /*
 1376: ================================================================================
 1377:   Fonction '*s' (modifie les échelles verticale et horizontale)
 1378: ================================================================================
 1379:   Entrées : structure processus
 1380: --------------------------------------------------------------------------------
 1381:   Sorties :
 1382: --------------------------------------------------------------------------------
 1383:   Effets de bord : néant
 1384: ================================================================================
 1385: */
 1386: 
 1387: void
 1388: instruction_star_s(struct_processus *s_etat_processus)
 1389: {
 1390:     struct_objet                *s_objet_argument;
 1391: 
 1392:     (*s_etat_processus).erreur_execution = d_ex;
 1393: 
 1394:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1395:     {
 1396:         printf("\n  *S ");
 1397: 
 1398:         if ((*s_etat_processus).langue == 'F')
 1399:         {
 1400:             printf("(multiplie les dimensions de la fenêtre graphique)\n\n");
 1401:         }
 1402:         else
 1403:         {
 1404:             printf("()\n\n");
 1405:         }
 1406: 
 1407:         printf("    1: %s, %s\n", d_INT, d_REL);
 1408: 
 1409:         return;
 1410:     }
 1411:     else if ((*s_etat_processus).test_instruction == 'Y')
 1412:     {
 1413:         (*s_etat_processus).nombre_arguments = -1;
 1414:         return;
 1415:     }
 1416:     
 1417:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1418:     {
 1419:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 1420:         {
 1421:             return;
 1422:         }
 1423:     }
 1424: 
 1425:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1426:             &s_objet_argument) == d_erreur)
 1427:     {
 1428:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1429:         return;
 1430:     }
 1431: 
 1432:     if ((*s_objet_argument).type == INT)
 1433:     {
 1434:         if ((*((integer8 *) (*s_objet_argument).objet)) <= 0)
 1435:         {
 1436:             liberation(s_etat_processus, s_objet_argument);
 1437: 
 1438:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
 1439:             return;
 1440:         }
 1441: 
 1442:         if ((*s_etat_processus).systeme_axes == 0)
 1443:         {
 1444:             (*s_etat_processus).x_min *= (real8) (*((integer8 *)
 1445:                     (*s_objet_argument).objet));
 1446:             (*s_etat_processus).x_max *= (real8) (*((integer8 *)
 1447:                     (*s_objet_argument).objet));
 1448:             (*s_etat_processus).y_min *= (real8) (*((integer8 *)
 1449:                     (*s_objet_argument).objet));
 1450:             (*s_etat_processus).y_max *= (real8) (*((integer8 *)
 1451:                     (*s_objet_argument).objet));
 1452:             (*s_etat_processus).z_min *= (real8) (*((integer8 *)
 1453:                     (*s_objet_argument).objet));
 1454:             (*s_etat_processus).z_max *= (real8) (*((integer8 *)
 1455:                     (*s_objet_argument).objet));
 1456:         }
 1457:         else
 1458:         {
 1459:             (*s_etat_processus).x2_min *= (real8) (*((integer8 *)
 1460:                     (*s_objet_argument).objet));
 1461:             (*s_etat_processus).x2_max *= (real8) (*((integer8 *)
 1462:                     (*s_objet_argument).objet));
 1463:             (*s_etat_processus).y2_min *= (real8) (*((integer8 *)
 1464:                     (*s_objet_argument).objet));
 1465:             (*s_etat_processus).y2_max *= (real8) (*((integer8 *)
 1466:                     (*s_objet_argument).objet));
 1467:             (*s_etat_processus).z2_min *= (real8) (*((integer8 *)
 1468:                     (*s_objet_argument).objet));
 1469:             (*s_etat_processus).z2_max *= (real8) (*((integer8 *)
 1470:                     (*s_objet_argument).objet));
 1471:         }
 1472:     }
 1473:     else if ((*s_objet_argument).type == REL)
 1474:     {
 1475:         if ((*((real8 *) (*s_objet_argument).objet)) <= 0)
 1476:         {
 1477:             liberation(s_etat_processus, s_objet_argument);
 1478: 
 1479:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
 1480:             return;
 1481:         }
 1482: 
 1483:         if ((*s_etat_processus).systeme_axes == 0)
 1484:         {
 1485:             (*s_etat_processus).x_min *= (*((real8 *)
 1486:                     (*s_objet_argument).objet));
 1487:             (*s_etat_processus).x_max *= (*((real8 *)
 1488:                     (*s_objet_argument).objet));
 1489:             (*s_etat_processus).y_min *= (*((real8 *)
 1490:                     (*s_objet_argument).objet));
 1491:             (*s_etat_processus).y_max *= (*((real8 *)
 1492:                     (*s_objet_argument).objet));
 1493:             (*s_etat_processus).z_min *= (*((real8 *)
 1494:                     (*s_objet_argument).objet));
 1495:             (*s_etat_processus).z_max *= (*((real8 *)
 1496:                     (*s_objet_argument).objet));
 1497:         }
 1498:         else
 1499:         {
 1500:             (*s_etat_processus).x2_min *= (*((real8 *)
 1501:                     (*s_objet_argument).objet));
 1502:             (*s_etat_processus).x2_max *= (*((real8 *)
 1503:                     (*s_objet_argument).objet));
 1504:             (*s_etat_processus).y2_min *= (*((real8 *)
 1505:                     (*s_objet_argument).objet));
 1506:             (*s_etat_processus).y2_max *= (*((real8 *)
 1507:                     (*s_objet_argument).objet));
 1508:             (*s_etat_processus).z2_min *= (*((real8 *)
 1509:                     (*s_objet_argument).objet));
 1510:             (*s_etat_processus).z2_max *= (*((real8 *)
 1511:                     (*s_objet_argument).objet));
 1512:         }
 1513:     }
 1514:     else
 1515:     {
 1516:         liberation(s_etat_processus, s_objet_argument);
 1517: 
 1518:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 1519:         return;
 1520:     }
 1521: 
 1522:     liberation(s_etat_processus, s_objet_argument);
 1523: 
 1524:     if (test_cfsf(s_etat_processus, 52) == d_faux)
 1525:     {
 1526:         if ((*s_etat_processus).fichiers_graphiques != NULL)
 1527:         {
 1528:             appel_gnuplot(s_etat_processus, 'N');
 1529:         }
 1530:     }
 1531: 
 1532:     return;
 1533: }
 1534: 
 1535: 
 1536: /*
 1537: ================================================================================
 1538:   Fonction 'stos'
 1539: ================================================================================
 1540:   Entrées : structure processus
 1541: --------------------------------------------------------------------------------
 1542:   Sorties :
 1543: --------------------------------------------------------------------------------
 1544:   Effets de bord : néant
 1545: ================================================================================
 1546: */
 1547: 
 1548: void
 1549: instruction_stos(struct_processus *s_etat_processus)
 1550: {
 1551:     logical1                            presence_variable;
 1552: 
 1553:     long                                i;
 1554: 
 1555:     struct_objet                        *s_objet;
 1556: 
 1557:     struct_variable                     s_variable;
 1558: 
 1559:     (*s_etat_processus).erreur_execution = d_ex;
 1560: 
 1561:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1562:     {
 1563:         printf("\n  STOS ");
 1564: 
 1565:         if ((*s_etat_processus).langue == 'F')
 1566:         {
 1567:             printf("(affectation de la variable %s)\n\n", ds_sdat);
 1568:         }
 1569:         else
 1570:         {
 1571:             printf("(store %s variable)\n\n", ds_sdat);
 1572:         }
 1573: 
 1574:         printf("    1: %s, %s, %s, %s, %s, %s,\n"
 1575:                 "       %s, %s, %s, %s, %s,\n"
 1576:                 "       %s, %s, %s, %s, %s,\n"
 1577:                 "       %s\n",
 1578:                 d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
 1579:                 d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
 1580: 
 1581:         return;
 1582:     }
 1583:     else if ((*s_etat_processus).test_instruction == 'Y')
 1584:     {
 1585:         (*s_etat_processus).nombre_arguments = -1;
 1586:         return;
 1587:     }
 1588: 
 1589:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1590:     {
 1591:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 1592:         {
 1593:             return;
 1594:         }
 1595:     }
 1596: 
 1597:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1598:             &s_objet) == d_erreur)
 1599:     {
 1600:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1601:         return;
 1602:     }
 1603: 
 1604:     if (recherche_variable(s_etat_processus, ds_sdat) == d_vrai)
 1605:     {
 1606:         /*
 1607:          * La variable préexiste. Il faut tester si celle-ci est globale
 1608:          * (de niveau 1).
 1609:          */
 1610: 
 1611:         i = (*s_etat_processus).position_variable_courante;
 1612:         presence_variable = d_faux;
 1613: 
 1614:         while(i >= 0)
 1615:         {
 1616:             if ((strcmp((*s_etat_processus).s_liste_variables[i].nom, ds_sdat)
 1617:                     == 0) && ((*s_etat_processus).s_liste_variables[i]
 1618:                     .niveau == 1))
 1619:             {
 1620:                 presence_variable = d_vrai;
 1621:                 break;
 1622:             }
 1623:              i--;
 1624:         }
 1625: 
 1626:         (*s_etat_processus).position_variable_courante = i;
 1627: 
 1628:         if (presence_variable == d_vrai)
 1629:         {
 1630:             if ((*s_etat_processus).s_liste_variables[(*s_etat_processus)
 1631:                     .position_variable_courante].variable_verrouillee ==
 1632:                     d_vrai)
 1633:             {
 1634:                 liberation(s_etat_processus, s_objet);
 1635: 
 1636:                 (*s_etat_processus).erreur_execution =
 1637:                         d_ex_variable_verrouillee;
 1638:                 return;
 1639:             }
 1640: 
 1641:             if ((*s_etat_processus).s_liste_variables[i].objet == NULL)
 1642:             {
 1643:                 liberation(s_etat_processus, s_objet);
 1644: 
 1645:                 (*s_etat_processus).erreur_execution = d_ex_variable_partagee;
 1646:                 return;
 1647:             }
 1648: 
 1649:             liberation(s_etat_processus,
 1650:                     (*s_etat_processus).s_liste_variables[(*s_etat_processus)
 1651:                     .position_variable_courante].objet);
 1652: 
 1653:             (*s_etat_processus).s_liste_variables[(*s_etat_processus)
 1654:                     .position_variable_courante].objet = s_objet;
 1655:         }
 1656:         else
 1657:         {
 1658:             if ((s_variable.nom = malloc(6 * sizeof(unsigned char))) == NULL)
 1659:             {
 1660:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1661:                 return;
 1662:             }
 1663: 
 1664:             strcpy(s_variable.nom, ds_sdat);
 1665:             s_variable.niveau = 1;
 1666: 
 1667:             /*
 1668:              * Le niveau 0 correspond aux définitions. Les variables
 1669:              * commencent à 1 car elles sont toujours incluses dans
 1670:              * une définition.
 1671:              */
 1672: 
 1673:             s_variable.objet = s_objet;
 1674: 
 1675:             if (creation_variable(s_etat_processus, &s_variable, 'V', 'P')
 1676:                     == d_erreur)
 1677:             {
 1678:                 return;
 1679:             }
 1680:         }
 1681:     }
 1682:     else
 1683:     {
 1684:         /*
 1685:          * La variable n'existe pas et on crée une variable globale.
 1686:          */
 1687: 
 1688:         if ((s_variable.nom = malloc(6 * sizeof(unsigned char))) == NULL)
 1689:         {
 1690:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1691:             return;
 1692:         }
 1693: 
 1694:         strcpy(s_variable.nom, ds_sdat);
 1695:         s_variable.niveau = 1;
 1696: 
 1697:         /*
 1698:          * Le niveau 0 correspond aux définitions. Les variables
 1699:          * commencent à 1 car elles sont toujours incluses dans
 1700:          * une définition.
 1701:          */
 1702: 
 1703:         s_variable.objet = s_objet;
 1704: 
 1705:         if (creation_variable(s_etat_processus, &s_variable, 'V', 'P')
 1706:                 == d_erreur)
 1707:         {
 1708:             return;
 1709:         }
 1710: 
 1711:         (*s_etat_processus).erreur_systeme = d_es;
 1712:     }
 1713: 
 1714:     return;
 1715: }
 1716: 
 1717: // vim: ts=4

CVSweb interface <joel.bertrand@systella.fr>