Annotation of rpl/src/instructions_s4.c, revision 1.1
1.1 ! bertrand 1: /*
! 2: ================================================================================
! 3: RPL/2 (R) version 4.0.9
! 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>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_s4.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src