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