Annotation of rpl/src/instructions_d1.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 'dec'
! 29: ================================================================================
! 30: Entrées : structure processus
! 31: --------------------------------------------------------------------------------
! 32: Sorties :
! 33: --------------------------------------------------------------------------------
! 34: Effets de bord : néant
! 35: ================================================================================
! 36: */
! 37:
! 38: void
! 39: instruction_dec(struct_processus *s_etat_processus)
! 40: {
! 41: (*s_etat_processus).erreur_execution = d_ex;
! 42:
! 43: if ((*s_etat_processus).affichage_arguments == 'Y')
! 44: {
! 45: printf("\n DEC ");
! 46:
! 47: if ((*s_etat_processus).langue == 'F')
! 48: {
! 49: printf("(base 10)\n\n");
! 50: printf(" Aucun argument\n");
! 51: }
! 52: else
! 53: {
! 54: printf("(decimal base)\n\n");
! 55: printf(" No argument\n");
! 56: }
! 57:
! 58: return;
! 59: }
! 60: else if ((*s_etat_processus).test_instruction == 'Y')
! 61: {
! 62: (*s_etat_processus).nombre_arguments = -1;
! 63: return;
! 64: }
! 65:
! 66: cf(s_etat_processus, 43);
! 67: cf(s_etat_processus, 44);
! 68:
! 69: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 70: {
! 71: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 72: {
! 73: return;
! 74: }
! 75: }
! 76:
! 77: return;
! 78: }
! 79:
! 80:
! 81: /*
! 82: ================================================================================
! 83: Fonction 'deg'
! 84: ================================================================================
! 85: Entrées : structure processus
! 86: --------------------------------------------------------------------------------
! 87: Sorties :
! 88: --------------------------------------------------------------------------------
! 89: Effets de bord : néant
! 90: ================================================================================
! 91: */
! 92:
! 93: void
! 94: instruction_deg(struct_processus *s_etat_processus)
! 95: {
! 96: (*s_etat_processus).erreur_execution = d_ex;
! 97:
! 98: if ((*s_etat_processus).affichage_arguments == 'Y')
! 99: {
! 100: printf("\n DEG ");
! 101:
! 102: if ((*s_etat_processus).langue == 'F')
! 103: {
! 104: printf("(arguments en degres)\n\n");
! 105: printf(" Aucun argument\n");
! 106: }
! 107: else
! 108: {
! 109: printf("(degrees)\n\n");
! 110: printf(" No argument\n");
! 111: }
! 112:
! 113: return;
! 114: }
! 115: else if ((*s_etat_processus).test_instruction == 'Y')
! 116: {
! 117: (*s_etat_processus).nombre_arguments = -1;
! 118: return;
! 119: }
! 120:
! 121: cf(s_etat_processus, 60);
! 122:
! 123: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 124: {
! 125: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 126: {
! 127: return;
! 128: }
! 129: }
! 130:
! 131: return;
! 132: }
! 133:
! 134:
! 135: /*
! 136: ================================================================================
! 137: Fonction 'depth'
! 138: ================================================================================
! 139: Entrées : structure processus
! 140: --------------------------------------------------------------------------------
! 141: Sorties :
! 142: --------------------------------------------------------------------------------
! 143: Effets de bord : néant
! 144: ================================================================================
! 145: */
! 146:
! 147: void
! 148: instruction_depth(struct_processus *s_etat_processus)
! 149: {
! 150: struct_objet *s_objet;
! 151:
! 152: (*s_etat_processus).erreur_execution = d_ex;
! 153:
! 154: if ((*s_etat_processus).affichage_arguments == 'Y')
! 155: {
! 156: printf("\n DEPTH ");
! 157:
! 158: if ((*s_etat_processus).langue == 'F')
! 159: {
! 160: printf("(profondeur de la pile)\n\n");
! 161: }
! 162: else
! 163: {
! 164: printf("(stack depth)\n\n");
! 165: }
! 166:
! 167: printf("-> 1: %s\n", d_INT);
! 168:
! 169: return;
! 170: }
! 171: else if ((*s_etat_processus).test_instruction == 'Y')
! 172: {
! 173: (*s_etat_processus).nombre_arguments = -1;
! 174: return;
! 175: }
! 176:
! 177: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 178: {
! 179: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 180: {
! 181: return;
! 182: }
! 183: }
! 184:
! 185: if ((s_objet = allocation(s_etat_processus, INT)) == NULL)
! 186: {
! 187: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 188: return;
! 189: }
! 190:
! 191: (*((integer8 *) ((*s_objet).objet))) = (integer8)
! 192: (*s_etat_processus).hauteur_pile_operationnelle;
! 193:
! 194: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 195: s_objet) == d_erreur)
! 196: {
! 197: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 198: return;
! 199: }
! 200:
! 201: return;
! 202: }
! 203:
! 204:
! 205: /*
! 206: ================================================================================
! 207: Fonction 'disp'
! 208: ================================================================================
! 209: Entrées : structure processus
! 210: --------------------------------------------------------------------------------
! 211: Sorties :
! 212: --------------------------------------------------------------------------------
! 213: Effets de bord : néant
! 214: ================================================================================
! 215: */
! 216:
! 217: void
! 218: instruction_disp(struct_processus *s_etat_processus)
! 219: {
! 220: struct_objet *s_objet;
! 221:
! 222: unsigned char *chaine;
! 223:
! 224: (*s_etat_processus).erreur_execution = d_ex;
! 225:
! 226: if ((*s_etat_processus).affichage_arguments == 'Y')
! 227: {
! 228: printf("\n DISP ");
! 229:
! 230: if ((*s_etat_processus).langue == 'F')
! 231: {
! 232: printf("(affichage d'un objet)\n\n");
! 233: }
! 234: else
! 235: {
! 236: printf("(display object)\n\n");
! 237: }
! 238:
! 239: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
! 240: " %s, %s, %s, %s, %s,\n"
! 241: " %s, %s, %s, %s, %s,\n"
! 242: " %s, %s, %s, %s,\n"
! 243: " %s, %s\n",
! 244: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 245: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 246: d_SQL, d_SLB, d_PRC, d_MTX);
! 247:
! 248: return;
! 249: }
! 250: else if ((*s_etat_processus).test_instruction == 'Y')
! 251: {
! 252: (*s_etat_processus).nombre_arguments = -1;
! 253: return;
! 254: }
! 255:
! 256: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 257: {
! 258: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 259: {
! 260: return;
! 261: }
! 262: }
! 263:
! 264: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 265: &s_objet) == d_erreur)
! 266: {
! 267: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 268: return;
! 269: }
! 270:
! 271: chaine = formateur(s_etat_processus, 0, s_objet);
! 272:
! 273: if (chaine != NULL)
! 274: {
! 275: flockfile(stdout);
! 276: fprintf(stdout, "%s", chaine);
! 277:
! 278: if (test_cfsf(s_etat_processus, 33) == d_faux)
! 279: {
! 280: fprintf(stdout, "\n");
! 281: }
! 282:
! 283: funlockfile(stdout);
! 284:
! 285: if (test_cfsf(s_etat_processus, 32) == d_vrai)
! 286: {
! 287: formateur_tex(s_etat_processus, s_objet, 'N');
! 288: }
! 289:
! 290: free(chaine);
! 291: }
! 292: else
! 293: {
! 294: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 295: return;
! 296: }
! 297:
! 298: liberation(s_etat_processus, s_objet);
! 299:
! 300: return;
! 301: }
! 302:
! 303:
! 304: /*
! 305: ================================================================================
! 306: Fonction 'drop'
! 307: ================================================================================
! 308: Entrées : structure processus
! 309: --------------------------------------------------------------------------------
! 310: Sorties :
! 311: --------------------------------------------------------------------------------
! 312: Effets de bord : néant
! 313: ================================================================================
! 314: */
! 315:
! 316: void
! 317: instruction_drop(struct_processus *s_etat_processus)
! 318: {
! 319: struct_objet *s_objet;
! 320:
! 321: (*s_etat_processus).erreur_execution = d_ex;
! 322:
! 323: if ((*s_etat_processus).affichage_arguments == 'Y')
! 324: {
! 325: printf("\n DROP ");
! 326:
! 327: if ((*s_etat_processus).langue == 'F')
! 328: {
! 329: printf("(effacement d'un objet)\n\n");
! 330: }
! 331: else
! 332: {
! 333: printf("(drop object)\n\n");
! 334: }
! 335:
! 336: printf(" n: %s, %s, %s, %s, %s, %s,\n"
! 337: " %s, %s, %s, %s, %s,\n"
! 338: " %s, %s, %s, %s, %s,\n"
! 339: " %s, %s, %s, %s,\n"
! 340: " %s, %s\n",
! 341: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 342: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 343: d_SQL, d_SLB, d_PRC, d_MTX);
! 344: printf(" ...\n");
! 345: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
! 346: " %s, %s, %s, %s, %s,\n"
! 347: " %s, %s, %s, %s, %s,\n"
! 348: " %s, %s, %s, %s,\n"
! 349: " %s, %s\n",
! 350: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 351: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 352: d_SQL, d_SLB, d_PRC, d_MTX);
! 353: printf("->n-1: %s, %s, %s, %s, %s, %s,\n"
! 354: " %s, %s, %s, %s, %s,\n"
! 355: " %s, %s, %s, %s, %s,\n"
! 356: " %s, %s, %s, %s,\n"
! 357: " %s, %s\n",
! 358: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 359: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 360: d_SQL, d_SLB, d_PRC, d_MTX);
! 361: printf(" ...\n");
! 362: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
! 363: " %s, %s, %s, %s, %s,\n"
! 364: " %s, %s, %s, %s, %s,\n"
! 365: " %s, %s, %s, %s,\n"
! 366: " %s, %s\n",
! 367: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 368: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 369: d_SQL, d_SLB, d_PRC, d_MTX);
! 370:
! 371: return;
! 372: }
! 373: else if ((*s_etat_processus).test_instruction == 'Y')
! 374: {
! 375: (*s_etat_processus).nombre_arguments = -1;
! 376: return;
! 377: }
! 378:
! 379: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 380: {
! 381: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 382: {
! 383: return;
! 384: }
! 385: }
! 386:
! 387: if ((*s_etat_processus).l_base_pile == NULL)
! 388: {
! 389: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 390: return;
! 391: }
! 392:
! 393: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 394: &s_objet) == d_erreur)
! 395: {
! 396: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 397: return;
! 398: }
! 399:
! 400: liberation(s_etat_processus, s_objet);
! 401:
! 402: return;
! 403: }
! 404:
! 405:
! 406: /*
! 407: ================================================================================
! 408: Fonction 'drop2'
! 409: ================================================================================
! 410: Entrées : structure processus
! 411: --------------------------------------------------------------------------------
! 412: Sorties :
! 413: --------------------------------------------------------------------------------
! 414: Effets de bord : néant
! 415: ================================================================================
! 416: */
! 417:
! 418: void
! 419: instruction_drop2(struct_processus *s_etat_processus)
! 420: {
! 421: struct_objet *s_objet;
! 422:
! 423: logical1 erreur;
! 424:
! 425: (*s_etat_processus).erreur_execution = d_ex;
! 426:
! 427: if ((*s_etat_processus).affichage_arguments == 'Y')
! 428: {
! 429: printf("\n DROP2 ");
! 430:
! 431: if ((*s_etat_processus).langue == 'F')
! 432: {
! 433: printf("(effacement de deux objets)\n\n");
! 434: }
! 435: else
! 436: {
! 437: printf("(drop two objects)\n\n");
! 438: }
! 439:
! 440: printf(" n: %s, %s, %s, %s, %s, %s,\n"
! 441: " %s, %s, %s, %s, %s,\n"
! 442: " %s, %s, %s, %s, %s,\n"
! 443: " %s, %s, %s, %s,\n"
! 444: " %s, %s\n",
! 445: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 446: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 447: d_SQL, d_SLB, d_PRC, d_MTX);
! 448: printf(" ...\n");
! 449: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
! 450: " %s, %s, %s, %s, %s,\n"
! 451: " %s, %s, %s, %s, %s,\n"
! 452: " %s, %s, %s, %s,\n"
! 453: " %s, %s\n",
! 454: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 455: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 456: d_SQL, d_SLB, d_PRC, d_MTX);
! 457: printf("->n-2: %s, %s, %s, %s, %s, %s,\n"
! 458: " %s, %s, %s, %s, %s,\n"
! 459: " %s, %s, %s, %s, %s,\n"
! 460: " %s, %s, %s, %s,\n"
! 461: " %s, %s\n",
! 462: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 463: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 464: d_SQL, d_SLB, d_PRC, d_MTX);
! 465: printf(" ...\n");
! 466: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
! 467: " %s, %s, %s, %s, %s,\n"
! 468: " %s, %s, %s, %s, %s,\n"
! 469: " %s, %s, %s, %s,\n"
! 470: " %s, %s\n",
! 471: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 472: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 473: d_SQL, d_SLB, d_PRC, d_MTX);
! 474:
! 475: return;
! 476: }
! 477: else if ((*s_etat_processus).test_instruction == 'Y')
! 478: {
! 479: (*s_etat_processus).nombre_arguments = -1;
! 480: return;
! 481: }
! 482:
! 483: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 484: {
! 485: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
! 486: {
! 487: return;
! 488: }
! 489: }
! 490:
! 491: if ((*s_etat_processus).hauteur_pile_operationnelle < 2)
! 492: {
! 493: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 494: return;
! 495: }
! 496:
! 497: erreur = depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 498: &s_objet);
! 499: liberation(s_etat_processus, s_objet);
! 500:
! 501: erreur = depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 502: &s_objet);
! 503: liberation(s_etat_processus, s_objet);
! 504:
! 505: return;
! 506: }
! 507:
! 508:
! 509: /*
! 510: ================================================================================
! 511: Fonction 'dropn'
! 512: ================================================================================
! 513: Entrées : structure processus
! 514: --------------------------------------------------------------------------------
! 515: Sorties :
! 516: --------------------------------------------------------------------------------
! 517: Effets de bord : néant
! 518: ================================================================================
! 519: */
! 520:
! 521: void
! 522: instruction_dropn(struct_processus *s_etat_processus)
! 523: {
! 524: struct_objet *s_objet;
! 525:
! 526: signed long nombre_suppressions;
! 527:
! 528: unsigned long i;
! 529:
! 530: (*s_etat_processus).erreur_execution = d_ex;
! 531:
! 532: if ((*s_etat_processus).affichage_arguments == 'Y')
! 533: {
! 534: printf("\n DROPN ");
! 535:
! 536: if ((*s_etat_processus).langue == 'F')
! 537: {
! 538: printf("(effacement de n objets)\n\n");
! 539: }
! 540: else
! 541: {
! 542: printf("(drop n objects)\n\n");
! 543: }
! 544:
! 545: printf(" m: %s, %s, %s, %s, %s, %s,\n"
! 546: " %s, %s, %s, %s, %s,\n"
! 547: " %s, %s, %s, %s, %s,\n"
! 548: " %s, %s, %s, %s,\n"
! 549: " %s, %s\n",
! 550: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 551: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 552: d_SQL, d_SLB, d_PRC, d_MTX);
! 553: printf(" ...\n");
! 554: printf(" 2: %s, %s, %s, %s, %s, %s,\n"
! 555: " %s, %s, %s, %s, %s,\n"
! 556: " %s, %s, %s, %s, %s,\n"
! 557: " %s, %s, %s, %s,\n"
! 558: " %s, %s\n",
! 559: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 560: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 561: d_SQL, d_SLB, d_PRC, d_MTX);
! 562: printf(" 1: %s\n", d_INT);
! 563: printf("->m-n: %s, %s, %s, %s, %s, %s,\n"
! 564: " %s, %s, %s, %s, %s,\n"
! 565: " %s, %s, %s, %s, %s,\n"
! 566: " %s, %s, %s, %s,\n"
! 567: " %s, %s\n",
! 568: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 569: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 570: d_SQL, d_SLB, d_PRC, d_MTX);
! 571: printf(" ...\n");
! 572: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
! 573: " %s, %s, %s, %s, %s,\n"
! 574: " %s, %s, %s, %s, %s,\n"
! 575: " %s, %s, %s, %s,\n"
! 576: " %s, %s\n",
! 577: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 578: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 579: d_SQL, d_SLB, d_PRC, d_MTX);
! 580:
! 581: return;
! 582: }
! 583: else if ((*s_etat_processus).test_instruction == 'Y')
! 584: {
! 585: (*s_etat_processus).nombre_arguments = -1;
! 586: return;
! 587: }
! 588:
! 589: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 590: {
! 591: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 592: {
! 593: return;
! 594: }
! 595: }
! 596:
! 597: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 598: &s_objet) == d_erreur)
! 599: {
! 600: return;
! 601: }
! 602:
! 603: if ((*s_objet).type != INT)
! 604: {
! 605: liberation(s_etat_processus, s_objet);
! 606:
! 607: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
! 608: return;
! 609: }
! 610:
! 611: nombre_suppressions = (*((integer8 *) (*s_objet).objet));
! 612: liberation(s_etat_processus, s_objet);
! 613:
! 614: if (nombre_suppressions < 0)
! 615: {
! 616:
! 617: /*
! 618: -- Opération absurde autorisée sur le calculateur HP-28S -----------------------
! 619: */
! 620:
! 621: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
! 622: return;
! 623: }
! 624:
! 625: if ((unsigned long) nombre_suppressions >
! 626: (*s_etat_processus).hauteur_pile_operationnelle)
! 627: {
! 628: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 629: return;
! 630: }
! 631:
! 632: for(i = 0; i < (unsigned long) nombre_suppressions; i++)
! 633: {
! 634: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 635: &s_objet) == d_erreur)
! 636: {
! 637: return;
! 638: }
! 639:
! 640: liberation(s_etat_processus, s_objet);
! 641: }
! 642:
! 643: return;
! 644: }
! 645:
! 646:
! 647: /*
! 648: ================================================================================
! 649: Fonction 'dup'
! 650: ================================================================================
! 651: Entrées : structure processus
! 652: --------------------------------------------------------------------------------
! 653: Sorties :
! 654: --------------------------------------------------------------------------------
! 655: Effets de bord : néant
! 656: ================================================================================
! 657: */
! 658:
! 659: void
! 660: instruction_dup(struct_processus *s_etat_processus)
! 661: {
! 662: struct_objet *s_objet;
! 663:
! 664: (*s_etat_processus).erreur_execution = d_ex;
! 665:
! 666: if ((*s_etat_processus).affichage_arguments == 'Y')
! 667: {
! 668: printf("\n DUP ");
! 669:
! 670: if ((*s_etat_processus).langue == 'F')
! 671: {
! 672: printf("(duplication d'un objet)\n\n");
! 673: }
! 674: else
! 675: {
! 676: printf("(duplication of object)\n\n");
! 677: }
! 678:
! 679: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
! 680: " %s, %s, %s, %s, %s,\n"
! 681: " %s, %s, %s, %s, %s,\n"
! 682: " %s, %s, %s, %s,\n"
! 683: " %s, %s\n",
! 684: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 685: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 686: d_SQL, d_SLB, d_PRC, d_MTX);
! 687: printf("-> 2: %s, %s, %s, %s, %s, %s,\n"
! 688: " %s, %s, %s, %s, %s,\n"
! 689: " %s, %s, %s, %s, %s,\n"
! 690: " %s, %s, %s, %s,\n"
! 691: " %s, %s\n",
! 692: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 693: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 694: d_SQL, d_SLB, d_PRC, d_MTX);
! 695: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
! 696: " %s, %s, %s, %s, %s,\n"
! 697: " %s, %s, %s, %s, %s,\n"
! 698: " %s, %s, %s, %s,\n"
! 699: " %s, %s\n",
! 700: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 701: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 702: d_SQL, d_SLB, d_PRC, d_MTX);
! 703:
! 704: return;
! 705: }
! 706: else if ((*s_etat_processus).test_instruction == 'Y')
! 707: {
! 708: (*s_etat_processus).nombre_arguments = -1;
! 709: return;
! 710: }
! 711:
! 712: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 713: {
! 714: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 715: {
! 716: return;
! 717: }
! 718: }
! 719:
! 720: if ((*s_etat_processus).l_base_pile == NULL)
! 721: {
! 722: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 723: return;
! 724: }
! 725:
! 726: s_objet = copie_objet(s_etat_processus,
! 727: (*(*s_etat_processus).l_base_pile).donnee, 'P');
! 728:
! 729: if (s_objet == NULL)
! 730: {
! 731: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 732: return;
! 733: }
! 734:
! 735: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 736: s_objet) == d_erreur)
! 737: {
! 738: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 739: return;
! 740: }
! 741:
! 742: return;
! 743: }
! 744:
! 745:
! 746: /*
! 747: ================================================================================
! 748: Fonction 'dup2'
! 749: ================================================================================
! 750: Entrées : structure processus
! 751: --------------------------------------------------------------------------------
! 752: Sorties :
! 753: --------------------------------------------------------------------------------
! 754: Effets de bord : néant
! 755: ================================================================================
! 756: */
! 757:
! 758: void
! 759: instruction_dup2(struct_processus *s_etat_processus)
! 760: {
! 761: struct_objet *s_objet;
! 762:
! 763: unsigned long i;
! 764:
! 765: (*s_etat_processus).erreur_execution = d_ex;
! 766:
! 767: if ((*s_etat_processus).affichage_arguments == 'Y')
! 768: {
! 769: printf("\n DUP2 ");
! 770:
! 771: if ((*s_etat_processus).langue == 'F')
! 772: {
! 773: printf("(duplication de deux objets)\n\n");
! 774: }
! 775: else
! 776: {
! 777: printf("(duplication of two objects)\n\n");
! 778: }
! 779:
! 780: printf(" 2: %s, %s, %s, %s, %s, %s,\n"
! 781: " %s, %s, %s, %s, %s,\n"
! 782: " %s, %s, %s, %s, %s,\n"
! 783: " %s, %s, %s, %s,\n"
! 784: " %s, %s\n",
! 785: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 786: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 787: d_SQL, d_SLB, d_PRC, d_MTX);
! 788: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
! 789: " %s, %s, %s, %s, %s,\n"
! 790: " %s, %s, %s, %s, %s,\n"
! 791: " %s, %s, %s, %s,\n"
! 792: " %s, %s\n",
! 793: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 794: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 795: d_SQL, d_SLB, d_PRC, d_MTX);
! 796: printf("-> 4: %s, %s, %s, %s, %s, %s,\n"
! 797: " %s, %s, %s, %s, %s,\n"
! 798: " %s, %s, %s, %s, %s,\n"
! 799: " %s, %s, %s, %s,\n"
! 800: " %s, %s\n",
! 801: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 802: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 803: d_SQL, d_SLB, d_PRC, d_MTX);
! 804: printf(" ...\n");
! 805: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
! 806: " %s, %s, %s, %s, %s,\n"
! 807: " %s, %s, %s, %s, %s,\n"
! 808: " %s, %s, %s, %s,\n"
! 809: " %s, %s\n",
! 810: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 811: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 812: d_SQL, d_SLB, d_PRC, d_MTX);
! 813:
! 814: return;
! 815: }
! 816: else if ((*s_etat_processus).test_instruction == 'Y')
! 817: {
! 818: (*s_etat_processus).nombre_arguments = -1;
! 819: return;
! 820: }
! 821:
! 822: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 823: {
! 824: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
! 825: {
! 826: return;
! 827: }
! 828: }
! 829:
! 830: if ((*s_etat_processus).hauteur_pile_operationnelle < 2)
! 831: {
! 832: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 833: return;
! 834: }
! 835:
! 836: for(i = 0; i < 2; i++)
! 837: {
! 838: s_objet = copie_objet(s_etat_processus,
! 839: (*(*(*s_etat_processus).l_base_pile).suivant).donnee, 'P');
! 840:
! 841: if (s_objet == NULL)
! 842: {
! 843: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 844: return;
! 845: }
! 846:
! 847: if (empilement(s_etat_processus, &((*s_etat_processus)
! 848: .l_base_pile), s_objet) == d_erreur)
! 849: {
! 850: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 851: return;
! 852: }
! 853: }
! 854:
! 855: return;
! 856: }
! 857:
! 858:
! 859: /*
! 860: ================================================================================
! 861: Fonction 'dupn'
! 862: ================================================================================
! 863: Entrées : structure processus
! 864: --------------------------------------------------------------------------------
! 865: Sorties :
! 866: --------------------------------------------------------------------------------
! 867: Effets de bord : néant
! 868: ================================================================================
! 869: */
! 870:
! 871: void
! 872: instruction_dupn(struct_processus *s_etat_processus)
! 873: {
! 874: struct_liste_chainee *l_base_pile;
! 875: struct_liste_chainee *l_element_courant;
! 876:
! 877: struct_objet *s_objet;
! 878: struct_objet *s_nouvel_objet;
! 879:
! 880: signed long nombre_duplications;
! 881: unsigned long i;
! 882:
! 883: (*s_etat_processus).erreur_execution = d_ex;
! 884:
! 885: if ((*s_etat_processus).affichage_arguments == 'Y')
! 886: {
! 887: printf("\n DUPN ");
! 888:
! 889: if ((*s_etat_processus).langue == 'F')
! 890: {
! 891: printf("(duplication de n objets)\n\n");
! 892: }
! 893: else
! 894: {
! 895: printf("(duplication of n objects)\n\n");
! 896: }
! 897:
! 898: printf(" m: %s, %s, %s, %s, %s, %s,\n"
! 899: " %s, %s, %s, %s, %s,\n"
! 900: " %s, %s, %s, %s, %s,\n"
! 901: " %s, %s, %s, %s,\n"
! 902: " %s, %s\n",
! 903: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 904: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 905: d_SQL, d_SLB, d_PRC, d_MTX);
! 906: printf(" ...\n");
! 907: printf(" 2: %s, %s, %s, %s, %s, %s,\n"
! 908: " %s, %s, %s, %s, %s,\n"
! 909: " %s, %s, %s, %s, %s,\n"
! 910: " %s, %s, %s, %s,\n"
! 911: " %s, %s\n",
! 912: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 913: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 914: d_SQL, d_SLB, d_PRC, d_MTX);
! 915: printf(" 1: %s\n", d_INT);
! 916: printf("->m+n: %s, %s, %s, %s, %s, %s,\n"
! 917: " %s, %s, %s, %s, %s,\n"
! 918: " %s, %s, %s, %s, %s,\n"
! 919: " %s, %s, %s, %s,\n"
! 920: " %s, %s\n",
! 921: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 922: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 923: d_SQL, d_SLB, d_PRC, d_MTX);
! 924: printf(" ...\n");
! 925: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
! 926: " %s, %s, %s, %s, %s,\n"
! 927: " %s, %s, %s, %s, %s,\n"
! 928: " %s, %s, %s, %s,\n"
! 929: " %s, %s\n",
! 930: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
! 931: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
! 932: d_SQL, d_SLB, d_PRC, d_MTX);
! 933:
! 934: return;
! 935: }
! 936: else if ((*s_etat_processus).test_instruction == 'Y')
! 937: {
! 938: (*s_etat_processus).nombre_arguments = -1;
! 939: return;
! 940: }
! 941:
! 942: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 943: {
! 944: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 945: {
! 946: return;
! 947: }
! 948: }
! 949:
! 950: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 951: &s_objet) == d_erreur)
! 952: {
! 953: return;
! 954: }
! 955:
! 956: if ((*s_objet).type != INT)
! 957: {
! 958: liberation(s_etat_processus, s_objet);
! 959:
! 960: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
! 961: return;
! 962: }
! 963:
! 964: nombre_duplications = (*((integer8 *) (*s_objet).objet));
! 965: liberation(s_etat_processus, s_objet);
! 966:
! 967: if (nombre_duplications < 0)
! 968: {
! 969:
! 970: /*
! 971: -- Opération absurde autorisée sur le calculateur HP-28S -----------------------
! 972: */
! 973:
! 974: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
! 975: return;
! 976: }
! 977:
! 978: l_element_courant = (*s_etat_processus).l_base_pile;
! 979:
! 980: for(i = 0; i < (unsigned long) nombre_duplications; i++)
! 981: {
! 982: if (l_element_courant == NULL)
! 983: {
! 984: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 985: return;
! 986: }
! 987:
! 988: s_nouvel_objet = copie_objet(s_etat_processus,
! 989: (*l_element_courant).donnee, 'P');
! 990:
! 991: if (s_nouvel_objet == NULL)
! 992: {
! 993: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 994: return;
! 995: }
! 996:
! 997: if (empilement(s_etat_processus, &l_base_pile, s_nouvel_objet)
! 998: == d_erreur)
! 999: {
! 1000: return;
! 1001: }
! 1002:
! 1003: l_element_courant = (*l_element_courant).suivant;
! 1004: }
! 1005:
! 1006: for(i = 0; i < (unsigned long) nombre_duplications; i++)
! 1007: {
! 1008: if (depilement(s_etat_processus, &l_base_pile, &s_objet) == d_erreur)
! 1009: {
! 1010: return;
! 1011: }
! 1012:
! 1013: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1014: s_objet) == d_erreur)
! 1015: {
! 1016: return;
! 1017: }
! 1018: }
! 1019:
! 1020: return;
! 1021: }
! 1022:
! 1023:
! 1024: /*
! 1025: ================================================================================
! 1026: Fonction '/'
! 1027: ================================================================================
! 1028: Entrées : structure processus
! 1029: --------------------------------------------------------------------------------
! 1030: Sorties :
! 1031: --------------------------------------------------------------------------------
! 1032: Effets de bord : néant
! 1033: ================================================================================
! 1034: */
! 1035:
! 1036: void
! 1037: instruction_division(struct_processus *s_etat_processus)
! 1038: {
! 1039: integer8 reste;
! 1040:
! 1041: real8 dividende_reel;
! 1042: real8 diviseur_reel;
! 1043:
! 1044: logical1 drapeau;
! 1045: logical1 resultat_entier;
! 1046:
! 1047: struct_complexe16 accumulateur;
! 1048:
! 1049: struct_liste_chainee *l_element_courant;
! 1050: struct_liste_chainee *l_element_precedent;
! 1051:
! 1052: struct_objet *s_copie_argument_1;
! 1053: struct_objet *s_copie_argument_2;
! 1054: struct_objet *s_objet_argument_1;
! 1055: struct_objet *s_objet_argument_2;
! 1056: struct_objet *s_objet_resultat;
! 1057:
! 1058: unsigned long i;
! 1059: unsigned long j;
! 1060: unsigned long k;
! 1061: unsigned long nombre_elements;
! 1062:
! 1063: (*s_etat_processus).erreur_execution = d_ex;
! 1064:
! 1065: if ((*s_etat_processus).affichage_arguments == 'Y')
! 1066: {
! 1067: printf("\n / ");
! 1068:
! 1069: if ((*s_etat_processus).langue == 'F')
! 1070: {
! 1071: printf("(division)\n\n");
! 1072: }
! 1073: else
! 1074: {
! 1075: printf("(division)\n\n");
! 1076: }
! 1077:
! 1078: printf(" 2: %s, %s, %s\n", d_INT, d_REL, d_CPL);
! 1079: printf(" 1: %s, %s, %s\n", d_INT, d_REL, d_CPL);
! 1080: printf("-> 1: %s, %s, %s\n\n", d_INT, d_REL, d_CPL);
! 1081:
! 1082: printf(" 2: %s, %s\n", d_NOM, d_ALG);
! 1083: printf(" 1: %s, %s, %s, %s, %s\n",
! 1084: d_INT, d_REL, d_CPL, d_NOM, d_ALG);
! 1085: printf("-> 1: %s\n\n", d_ALG);
! 1086:
! 1087: printf(" 2: %s, %s, %s, %s, %s\n",
! 1088: d_INT, d_REL, d_CPL, d_NOM, d_ALG);
! 1089: printf(" 1: %s, %s\n", d_NOM, d_ALG);
! 1090: printf("-> 1: %s\n\n", d_ALG);
! 1091:
! 1092: printf(" 2: %s\n", d_RPN);
! 1093: printf(" 1: %s, %s, %s, %s, %s\n",
! 1094: d_INT, d_REL, d_CPL, d_NOM, d_RPN);
! 1095: printf("-> 1: %s\n\n", d_RPN);
! 1096:
! 1097: printf(" 2: %s, %s, %s, %s, %s\n",
! 1098: d_INT, d_REL, d_CPL, d_NOM, d_RPN);
! 1099: printf(" 1: %s\n", d_RPN);
! 1100: printf("-> 1: %s\n\n", d_RPN);
! 1101:
! 1102: printf(" 2: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
! 1103: printf(" 1: %s, %s, %s\n", d_INT, d_REL, d_CPL);
! 1104: printf("-> 1: %s, %s, %s\n\n", d_VIN, d_VRL, d_VCX);
! 1105:
! 1106: printf(" 2: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
! 1107: printf(" 1: %s, %s, %s\n", d_INT, d_REL, d_CPL);
! 1108: printf("-> 1: %s, %s, %s\n\n", d_MIN, d_MRL, d_MCX);
! 1109:
! 1110: printf(" 2: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
! 1111: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
! 1112: printf("-> 1: %s, %s\n\n", d_VRL, d_VCX);
! 1113:
! 1114: printf(" 2: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
! 1115: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
! 1116: printf("-> 1: %s, %s\n\n", d_MRL, d_MCX);
! 1117:
! 1118: printf(" 2: %s, %s\n", d_BIN, d_INT);
! 1119: printf(" 1: %s, %s\n", d_BIN, d_INT);
! 1120: printf("-> 1: %s\n", d_BIN);
! 1121:
! 1122: return;
! 1123: }
! 1124: else if ((*s_etat_processus).test_instruction == 'Y')
! 1125: {
! 1126: (*s_etat_processus).nombre_arguments = 0;
! 1127: return;
! 1128: }
! 1129:
! 1130: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 1131: {
! 1132: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
! 1133: {
! 1134: return;
! 1135: }
! 1136: }
! 1137:
! 1138: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1139: &s_objet_argument_1) == d_erreur)
! 1140: {
! 1141: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 1142: return;
! 1143: }
! 1144:
! 1145: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1146: &s_objet_argument_2) == d_erreur)
! 1147: {
! 1148: liberation(s_etat_processus, s_objet_argument_1);
! 1149:
! 1150: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 1151: return;
! 1152: }
! 1153:
! 1154: /*
! 1155: --------------------------------------------------------------------------------
! 1156: Division donnant un résultat réel (ou entier si cela reste correct)
! 1157: --------------------------------------------------------------------------------
! 1158: */
! 1159:
! 1160: if ((((*s_objet_argument_1).type == INT) ||
! 1161: ((*s_objet_argument_1).type == REL)) &&
! 1162: (((*s_objet_argument_2).type == INT) ||
! 1163: ((*s_objet_argument_2).type == REL)))
! 1164: {
! 1165: if (((*s_objet_argument_2).type == INT) &&
! 1166: ((*s_objet_argument_1).type == INT))
! 1167: {
! 1168: if ((*((integer8 *) (*s_objet_argument_1).objet)) == 0)
! 1169: {
! 1170: reste = -1;
! 1171: }
! 1172: else
! 1173: {
! 1174: reste = (*((integer8 *) (*s_objet_argument_2).objet)) %
! 1175: (*((integer8 *) (*s_objet_argument_1).objet));
! 1176: }
! 1177: }
! 1178: else
! 1179: {
! 1180: reste = -1;
! 1181: }
! 1182:
! 1183: if (reste == 0)
! 1184: {
! 1185: /*
! 1186: * Résultat entier
! 1187: */
! 1188:
! 1189: if ((s_objet_resultat = allocation(s_etat_processus, INT))
! 1190: == NULL)
! 1191: {
! 1192: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1193: return;
! 1194: }
! 1195:
! 1196: (*((integer8 *) (*s_objet_resultat).objet)) = (*((integer8 *)
! 1197: (*s_objet_argument_2).objet)) / (*((integer8 *)
! 1198: (*s_objet_argument_1).objet));
! 1199: }
! 1200: else
! 1201: {
! 1202: /*
! 1203: * Résultat réel
! 1204: */
! 1205:
! 1206: if ((s_objet_resultat = allocation(s_etat_processus, REL))
! 1207: == NULL)
! 1208: {
! 1209: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1210: return;
! 1211: }
! 1212:
! 1213: if ((*s_objet_argument_1).type == INT)
! 1214: {
! 1215: diviseur_reel = (real8) (*((integer8 *)
! 1216: (*s_objet_argument_1).objet));
! 1217: }
! 1218: else
! 1219: {
! 1220: diviseur_reel = (*((real8 *) (*s_objet_argument_1).objet));
! 1221: }
! 1222:
! 1223: if ((*s_objet_argument_2).type == INT)
! 1224: {
! 1225: dividende_reel = (real8) (*((integer8 *)
! 1226: (*s_objet_argument_2).objet));
! 1227: }
! 1228: else
! 1229: {
! 1230: dividende_reel = (*((real8 *) (*s_objet_argument_2).objet));
! 1231: }
! 1232:
! 1233: if ((diviseur_reel == 0) && (test_cfsf(s_etat_processus, 59) ==
! 1234: d_vrai))
! 1235: {
! 1236: liberation(s_etat_processus, s_objet_argument_1);
! 1237: liberation(s_etat_processus, s_objet_argument_2);
! 1238: liberation(s_etat_processus, s_objet_resultat);
! 1239:
! 1240: (*s_etat_processus).exception = d_ep_division_par_zero;
! 1241: return;
! 1242: }
! 1243:
! 1244: (*((real8 *) (*s_objet_resultat).objet)) = dividende_reel /
! 1245: diviseur_reel;
! 1246: }
! 1247: }
! 1248:
! 1249: /*
! 1250: --------------------------------------------------------------------------------
! 1251: Division donnant un résultat complexe
! 1252: --------------------------------------------------------------------------------
! 1253: */
! 1254:
! 1255: else if ((((*s_objet_argument_1).type == CPL) &&
! 1256: (((*s_objet_argument_2).type == INT) ||
! 1257: ((*s_objet_argument_2).type == REL) ||
! 1258: ((*s_objet_argument_2).type == CPL))) ||
! 1259: (((*s_objet_argument_2).type == CPL) &&
! 1260: (((*s_objet_argument_1).type == INT) ||
! 1261: ((*s_objet_argument_1).type == REL) ||
! 1262: ((*s_objet_argument_1).type == CPL))))
! 1263: {
! 1264: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
! 1265: {
! 1266: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1267: return;
! 1268: }
! 1269:
! 1270: if ((*s_objet_argument_1).type == CPL)
! 1271: {
! 1272: if (((*((struct_complexe16 *) (*s_objet_argument_1).objet))
! 1273: .partie_reelle == 0) && ((*((struct_complexe16 *)
! 1274: (*s_objet_argument_1).objet)).partie_imaginaire == 0))
! 1275: {
! 1276: liberation(s_etat_processus, s_objet_argument_1);
! 1277: liberation(s_etat_processus, s_objet_argument_2);
! 1278: liberation(s_etat_processus, s_objet_resultat);
! 1279:
! 1280: (*s_etat_processus).exception = d_ep_division_par_zero;
! 1281: return;
! 1282: }
! 1283:
! 1284: if ((*s_objet_argument_2).type == INT)
! 1285: {
! 1286: f77divisionic_(&((*((integer8 *) (*s_objet_argument_2)
! 1287: .objet))), &((*((struct_complexe16 *)
! 1288: (*s_objet_argument_1).objet))),
! 1289: &((*((struct_complexe16 *)
! 1290: (*s_objet_resultat).objet))));
! 1291: }
! 1292: else if ((*s_objet_argument_2).type == REL)
! 1293: {
! 1294: f77divisionrc_(&((*((real8 *) (*s_objet_argument_2)
! 1295: .objet))), &((*((struct_complexe16 *)
! 1296: (*s_objet_argument_1).objet))),
! 1297: &((*((struct_complexe16 *)
! 1298: (*s_objet_resultat).objet))));
! 1299: }
! 1300: else
! 1301: {
! 1302: f77divisioncc_(&((*((struct_complexe16 *) (*s_objet_argument_2)
! 1303: .objet))), &((*((struct_complexe16 *)
! 1304: (*s_objet_argument_1).objet))),
! 1305: &((*((struct_complexe16 *)
! 1306: (*s_objet_resultat).objet))));
! 1307: }
! 1308: }
! 1309: else
! 1310: {
! 1311: if ((*s_objet_argument_1).type == INT)
! 1312: {
! 1313: if ((*((integer8 *) (*s_objet_argument_1).objet)) == 0)
! 1314: {
! 1315: liberation(s_etat_processus, s_objet_argument_1);
! 1316: liberation(s_etat_processus, s_objet_argument_2);
! 1317: liberation(s_etat_processus, s_objet_resultat);
! 1318:
! 1319: (*s_etat_processus).exception = d_ep_division_par_zero;
! 1320: return;
! 1321: }
! 1322:
! 1323: f77divisionci_(&((*((struct_complexe16 *) (*s_objet_argument_2)
! 1324: .objet))), &((*((integer8 *)
! 1325: (*s_objet_argument_1).objet))),
! 1326: &((*((struct_complexe16 *)
! 1327: (*s_objet_resultat).objet))));
! 1328: }
! 1329: else
! 1330: {
! 1331: if ((*((real8 *) (*s_objet_argument_1).objet)) == 0)
! 1332: {
! 1333: liberation(s_etat_processus, s_objet_argument_1);
! 1334: liberation(s_etat_processus, s_objet_argument_2);
! 1335: liberation(s_etat_processus, s_objet_resultat);
! 1336:
! 1337: (*s_etat_processus).exception = d_ep_division_par_zero;
! 1338: return;
! 1339: }
! 1340:
! 1341: f77divisioncr_(&((*((struct_complexe16 *) (*s_objet_argument_2)
! 1342: .objet))), &((*((real8 *)
! 1343: (*s_objet_argument_1).objet))),
! 1344: &((*((struct_complexe16 *)
! 1345: (*s_objet_resultat).objet))));
! 1346: }
! 1347: }
! 1348: }
! 1349:
! 1350: /*
! 1351: --------------------------------------------------------------------------------
! 1352: Division mettant en oeuvre un nom ou une expression algébrique
! 1353: --------------------------------------------------------------------------------
! 1354: */
! 1355: /*
! 1356: * Nom ou valeur numérique / Nom ou valeur numérique
! 1357: */
! 1358:
! 1359: else if ((((*s_objet_argument_1).type == NOM) &&
! 1360: (((*s_objet_argument_2).type == NOM) ||
! 1361: ((*s_objet_argument_2).type == INT) ||
! 1362: ((*s_objet_argument_2).type == REL) ||
! 1363: ((*s_objet_argument_2).type == CPL))) ||
! 1364: (((*s_objet_argument_2).type == NOM) &&
! 1365: (((*s_objet_argument_1).type == INT) ||
! 1366: ((*s_objet_argument_1).type == REL) ||
! 1367: ((*s_objet_argument_1).type == CPL))))
! 1368: {
! 1369: drapeau = d_vrai;
! 1370:
! 1371: if ((*s_objet_argument_2).type == NOM)
! 1372: {
! 1373: if ((*s_objet_argument_1).type == INT)
! 1374: {
! 1375: if ((*((integer8 *) (*s_objet_argument_1).objet)) == 1)
! 1376: { // Division par 1
! 1377: drapeau = d_faux;
! 1378:
! 1379: s_objet_resultat = s_objet_argument_2;
! 1380: s_objet_argument_2 = NULL;
! 1381: }
! 1382: }
! 1383: else if ((*s_objet_argument_1).type == REL)
! 1384: {
! 1385: if ((*((real8 *) (*s_objet_argument_1).objet)) == 1)
! 1386: { // Division par 1.0
! 1387: drapeau = d_faux;
! 1388:
! 1389: s_objet_resultat = s_objet_argument_2;
! 1390: s_objet_argument_2 = NULL;
! 1391: }
! 1392: }
! 1393: else if ((*s_objet_argument_1).type == CPL)
! 1394: {
! 1395: if (((*((complex16 *) (*s_objet_argument_1).objet))
! 1396: .partie_reelle == 1) && ((*((complex16 *)
! 1397: (*s_objet_argument_1).objet)).partie_imaginaire == 0))
! 1398: { // Division par (1.0,0.0)
! 1399: drapeau = d_faux;
! 1400:
! 1401: s_objet_resultat = s_objet_argument_2;
! 1402: s_objet_argument_2 = NULL;
! 1403: }
! 1404: }
! 1405: }
! 1406: else if ((*s_objet_argument_1).type == NOM)
! 1407: {
! 1408: if ((*s_objet_argument_2).type == INT)
! 1409: {
! 1410: if ((*((integer8 *) (*s_objet_argument_2).objet)) == 0)
! 1411: { // Dividende nul
! 1412: drapeau = d_faux;
! 1413:
! 1414: if ((s_objet_resultat = allocation(s_etat_processus, INT))
! 1415: == NULL)
! 1416: {
! 1417: (*s_etat_processus).erreur_systeme =
! 1418: d_es_allocation_memoire;
! 1419: return;
! 1420: }
! 1421:
! 1422: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
! 1423: }
! 1424: }
! 1425: else if ((*s_objet_argument_2).type == REL)
! 1426: {
! 1427: if ((*((real8 *) (*s_objet_argument_2).objet)) == 0)
! 1428: { // Dividende nul
! 1429: drapeau = d_faux;
! 1430:
! 1431: if ((s_objet_resultat = allocation(s_etat_processus, INT))
! 1432: == NULL)
! 1433: {
! 1434: (*s_etat_processus).erreur_systeme =
! 1435: d_es_allocation_memoire;
! 1436: return;
! 1437: }
! 1438:
! 1439: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
! 1440: }
! 1441: }
! 1442: else if ((*s_objet_argument_2).type == CPL)
! 1443: {
! 1444: if (((*((complex16 *) (*s_objet_argument_2).objet))
! 1445: .partie_reelle == 0) && ((*((complex16 *)
! 1446: (*s_objet_argument_2).objet)).partie_imaginaire == 0))
! 1447: { // Dividende nul
! 1448: drapeau = d_faux;
! 1449:
! 1450: if ((s_objet_resultat = allocation(s_etat_processus, INT))
! 1451: == NULL)
! 1452: {
! 1453: (*s_etat_processus).erreur_systeme =
! 1454: d_es_allocation_memoire;
! 1455: return;
! 1456: }
! 1457:
! 1458: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
! 1459: }
! 1460: }
! 1461: }
! 1462:
! 1463: if (drapeau == d_vrai)
! 1464: {
! 1465: if ((s_objet_resultat = allocation(s_etat_processus, ALG))
! 1466: == NULL)
! 1467: {
! 1468: (*s_etat_processus).erreur_systeme =
! 1469: d_es_allocation_memoire;
! 1470: return;
! 1471: }
! 1472:
! 1473: if (((*s_objet_resultat).objet =
! 1474: allocation_maillon(s_etat_processus)) == NULL)
! 1475: {
! 1476: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1477: return;
! 1478: }
! 1479:
! 1480: l_element_courant = (*s_objet_resultat).objet;
! 1481:
! 1482: if (((*l_element_courant).donnee =
! 1483: allocation(s_etat_processus, FCT)) == NULL)
! 1484: {
! 1485: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1486: return;
! 1487: }
! 1488:
! 1489: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1490: .nombre_arguments = 0;
! 1491: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1492: .fonction = instruction_vers_niveau_superieur;
! 1493:
! 1494: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1495: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 1496: {
! 1497: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1498: return;
! 1499: }
! 1500:
! 1501: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1502: .nom_fonction, "<<");
! 1503:
! 1504: if (((*l_element_courant).suivant =
! 1505: allocation_maillon(s_etat_processus)) == NULL)
! 1506: {
! 1507: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1508: return;
! 1509: }
! 1510:
! 1511: l_element_courant = (*l_element_courant).suivant;
! 1512: (*l_element_courant).donnee = s_objet_argument_2;
! 1513:
! 1514: if (((*l_element_courant).suivant =
! 1515: allocation_maillon(s_etat_processus)) == NULL)
! 1516: {
! 1517: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1518: return;
! 1519: }
! 1520:
! 1521: l_element_courant = (*l_element_courant).suivant;
! 1522: (*l_element_courant).donnee = s_objet_argument_1;
! 1523:
! 1524: if (((*l_element_courant).suivant =
! 1525: allocation_maillon(s_etat_processus)) == NULL)
! 1526: {
! 1527: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1528: return;
! 1529: }
! 1530:
! 1531: l_element_courant = (*l_element_courant).suivant;
! 1532:
! 1533: if (((*l_element_courant).donnee =
! 1534: allocation(s_etat_processus, FCT)) == NULL)
! 1535: {
! 1536: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1537: return;
! 1538: }
! 1539:
! 1540: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1541: .nombre_arguments = 0;
! 1542: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1543: .fonction = instruction_division;
! 1544:
! 1545: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1546: .nom_fonction = malloc(2 * sizeof(unsigned char))) == NULL)
! 1547: {
! 1548: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1549: return;
! 1550: }
! 1551:
! 1552: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1553: .nom_fonction, "/");
! 1554:
! 1555: if (((*l_element_courant).suivant =
! 1556: allocation_maillon(s_etat_processus)) == NULL)
! 1557: {
! 1558: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1559: return;
! 1560: }
! 1561:
! 1562: l_element_courant = (*l_element_courant).suivant;
! 1563:
! 1564: if (((*l_element_courant).donnee =
! 1565: allocation(s_etat_processus, FCT)) == NULL)
! 1566: {
! 1567: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1568: return;
! 1569: }
! 1570:
! 1571: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1572: .nombre_arguments = 0;
! 1573: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1574: .fonction = instruction_vers_niveau_inferieur;
! 1575:
! 1576: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1577: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 1578: {
! 1579: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1580: return;
! 1581: }
! 1582:
! 1583: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1584: .nom_fonction, ">>");
! 1585:
! 1586: (*l_element_courant).suivant = NULL;
! 1587:
! 1588: s_objet_argument_1 = NULL;
! 1589: s_objet_argument_2 = NULL;
! 1590: }
! 1591: }
! 1592:
! 1593: /*
! 1594: * Nom ou valeur numérique / Expression
! 1595: */
! 1596:
! 1597: else if ((((*s_objet_argument_1).type == ALG) ||
! 1598: ((*s_objet_argument_1).type == RPN)) &&
! 1599: (((*s_objet_argument_2).type == NOM) ||
! 1600: ((*s_objet_argument_2).type == INT) ||
! 1601: ((*s_objet_argument_2).type == REL) ||
! 1602: ((*s_objet_argument_2).type == CPL)))
! 1603: {
! 1604: drapeau = d_vrai;
! 1605:
! 1606: nombre_elements = 0;
! 1607: l_element_courant = (struct_liste_chainee *)
! 1608: (*s_objet_argument_1).objet;
! 1609:
! 1610: while(l_element_courant != NULL)
! 1611: {
! 1612: nombre_elements++;
! 1613: l_element_courant = (*l_element_courant).suivant;
! 1614: }
! 1615:
! 1616: if (nombre_elements == 2)
! 1617: {
! 1618: liberation(s_etat_processus, s_objet_argument_1);
! 1619: liberation(s_etat_processus, s_objet_argument_1);
! 1620:
! 1621: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
! 1622: return;
! 1623: }
! 1624:
! 1625: if ((*s_objet_argument_2).type == INT)
! 1626: {
! 1627: if ((*((integer8 *) (*s_objet_argument_2).objet)) == 0)
! 1628: {
! 1629: drapeau = d_faux;
! 1630:
! 1631: if ((s_objet_resultat = allocation(s_etat_processus, INT))
! 1632: == NULL)
! 1633: {
! 1634: (*s_etat_processus).erreur_systeme =
! 1635: d_es_allocation_memoire;
! 1636: return;
! 1637: }
! 1638:
! 1639: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
! 1640: }
! 1641: }
! 1642: else if ((*s_objet_argument_2).type == REL)
! 1643: {
! 1644: if ((*((real8 *) (*s_objet_argument_2).objet)) == 0)
! 1645: {
! 1646: drapeau = d_faux;
! 1647:
! 1648: if ((s_objet_resultat = allocation(s_etat_processus, INT))
! 1649: == NULL)
! 1650: {
! 1651: (*s_etat_processus).erreur_systeme =
! 1652: d_es_allocation_memoire;
! 1653: return;
! 1654: }
! 1655:
! 1656: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
! 1657: }
! 1658: }
! 1659: else if ((*s_objet_argument_2).type == CPL)
! 1660: {
! 1661: if (((*((complex16 *) (*s_objet_argument_2).objet))
! 1662: .partie_reelle == 0) && ((*((complex16 *)
! 1663: (*s_objet_argument_2).objet)).partie_imaginaire == 0))
! 1664: {
! 1665: drapeau = d_faux;
! 1666:
! 1667: if ((s_objet_resultat = allocation(s_etat_processus, INT))
! 1668: == NULL)
! 1669: {
! 1670: (*s_etat_processus).erreur_systeme =
! 1671: d_es_allocation_memoire;
! 1672: return;
! 1673: }
! 1674:
! 1675: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
! 1676: }
! 1677: }
! 1678:
! 1679: if (drapeau == d_vrai)
! 1680: {
! 1681: if ((s_objet_resultat = copie_objet(s_etat_processus,
! 1682: s_objet_argument_1, 'N')) == NULL)
! 1683: {
! 1684: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1685: return;
! 1686: }
! 1687:
! 1688: l_element_courant = (struct_liste_chainee *)
! 1689: (*s_objet_resultat).objet;
! 1690: l_element_precedent = l_element_courant;
! 1691: l_element_courant = (*l_element_courant).suivant;
! 1692:
! 1693: if (((*l_element_precedent).suivant =
! 1694: allocation_maillon(s_etat_processus)) == NULL)
! 1695: {
! 1696: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1697: return;
! 1698: }
! 1699:
! 1700: (*(*l_element_precedent).suivant).donnee = s_objet_argument_2;
! 1701: (*(*l_element_precedent).suivant).suivant = l_element_courant;
! 1702:
! 1703: while((*l_element_courant).suivant != NULL)
! 1704: {
! 1705: l_element_precedent = l_element_courant;
! 1706: l_element_courant = (*l_element_courant).suivant;
! 1707: }
! 1708:
! 1709: if (((*l_element_precedent).suivant =
! 1710: allocation_maillon(s_etat_processus)) == NULL)
! 1711: {
! 1712: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1713: return;
! 1714: }
! 1715:
! 1716: if (((*(*l_element_precedent).suivant).donnee =
! 1717: allocation(s_etat_processus, FCT)) == NULL)
! 1718: {
! 1719: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1720: return;
! 1721: }
! 1722:
! 1723: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 1724: .donnee).objet)).nombre_arguments = 0;
! 1725: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 1726: .donnee).objet)).fonction = instruction_division;
! 1727:
! 1728: if (((*((struct_fonction *) (*(*(*l_element_precedent)
! 1729: .suivant).donnee).objet)).nom_fonction =
! 1730: malloc(2 * sizeof(unsigned char))) == NULL)
! 1731: {
! 1732: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1733: return;
! 1734: }
! 1735:
! 1736: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
! 1737: .suivant).donnee).objet)).nom_fonction, "/");
! 1738:
! 1739: (*(*l_element_precedent).suivant).suivant = l_element_courant;
! 1740:
! 1741: s_objet_argument_2 = NULL;
! 1742: }
! 1743: }
! 1744:
! 1745: /*
! 1746: * Expression / Nom ou valeur numérique
! 1747: */
! 1748:
! 1749: else if ((((*s_objet_argument_1).type == NOM) ||
! 1750: ((*s_objet_argument_1).type == INT) ||
! 1751: ((*s_objet_argument_1).type == REL) ||
! 1752: ((*s_objet_argument_1).type == CPL)) &&
! 1753: (((*s_objet_argument_2).type == ALG) ||
! 1754: ((*s_objet_argument_2).type == RPN)))
! 1755: {
! 1756: drapeau = d_vrai;
! 1757:
! 1758: nombre_elements = 0;
! 1759: l_element_courant = (struct_liste_chainee *)
! 1760: (*s_objet_argument_2).objet;
! 1761:
! 1762: while(l_element_courant != NULL)
! 1763: {
! 1764: nombre_elements++;
! 1765: l_element_courant = (*l_element_courant).suivant;
! 1766: }
! 1767:
! 1768: if (nombre_elements == 2)
! 1769: {
! 1770: liberation(s_etat_processus, s_objet_argument_1);
! 1771: liberation(s_etat_processus, s_objet_argument_2);
! 1772:
! 1773: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
! 1774: return;
! 1775: }
! 1776:
! 1777: if ((*s_objet_argument_1).type == INT)
! 1778: {
! 1779: if ((*((integer8 *) (*s_objet_argument_1).objet)) == 1)
! 1780: {
! 1781: drapeau = d_faux;
! 1782:
! 1783: s_objet_resultat = s_objet_argument_2;
! 1784: s_objet_argument_2 = NULL;
! 1785: }
! 1786: }
! 1787: else if ((*s_objet_argument_1).type == REL)
! 1788: {
! 1789: if ((*((real8 *) (*s_objet_argument_1).objet)) == 1)
! 1790: {
! 1791: drapeau = d_faux;
! 1792:
! 1793: s_objet_resultat = s_objet_argument_2;
! 1794: s_objet_argument_2 = NULL;
! 1795: }
! 1796: }
! 1797: else if ((*s_objet_argument_1).type == CPL)
! 1798: {
! 1799: if (((*((complex16 *) (*s_objet_argument_1).objet))
! 1800: .partie_reelle == 1) && ((*((complex16 *)
! 1801: (*s_objet_argument_1).objet)).partie_imaginaire == 0))
! 1802: {
! 1803: drapeau = d_faux;
! 1804:
! 1805: s_objet_resultat = s_objet_argument_2;
! 1806: s_objet_argument_2 = NULL;
! 1807: }
! 1808: }
! 1809:
! 1810: if (drapeau == d_vrai)
! 1811: {
! 1812: if ((s_objet_resultat = copie_objet(s_etat_processus,
! 1813: s_objet_argument_2, 'N')) == NULL)
! 1814: {
! 1815: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1816: return;
! 1817: }
! 1818:
! 1819: l_element_courant = (struct_liste_chainee *)
! 1820: (*s_objet_resultat).objet;
! 1821: l_element_precedent = l_element_courant;
! 1822:
! 1823: while((*l_element_courant).suivant != NULL)
! 1824: {
! 1825: l_element_precedent = l_element_courant;
! 1826: l_element_courant = (*l_element_courant).suivant;
! 1827: }
! 1828:
! 1829: if (((*l_element_precedent).suivant =
! 1830: allocation_maillon(s_etat_processus)) == NULL)
! 1831: {
! 1832: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1833: return;
! 1834: }
! 1835:
! 1836: (*(*l_element_precedent).suivant).donnee = s_objet_argument_1;
! 1837: l_element_precedent = (*l_element_precedent).suivant;
! 1838:
! 1839: if (((*l_element_precedent).suivant =
! 1840: allocation_maillon(s_etat_processus)) == NULL)
! 1841: {
! 1842: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1843: return;
! 1844: }
! 1845:
! 1846: if (((*(*l_element_precedent).suivant).donnee =
! 1847: allocation(s_etat_processus, FCT)) == NULL)
! 1848: {
! 1849: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1850: return;
! 1851: }
! 1852:
! 1853: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 1854: .donnee).objet)).nombre_arguments = 0;
! 1855: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 1856: .donnee).objet)).fonction = instruction_division;
! 1857:
! 1858: if (((*((struct_fonction *) (*(*(*l_element_precedent)
! 1859: .suivant).donnee).objet)).nom_fonction =
! 1860: malloc(2 * sizeof(unsigned char))) == NULL)
! 1861: {
! 1862: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1863: return;
! 1864: }
! 1865:
! 1866: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
! 1867: .suivant).donnee).objet)).nom_fonction, "/");
! 1868:
! 1869: (*(*l_element_precedent).suivant).suivant = l_element_courant;
! 1870:
! 1871: s_objet_argument_1 = NULL;
! 1872: }
! 1873: }
! 1874:
! 1875: /*
! 1876: * Expression / Expression
! 1877: */
! 1878:
! 1879: else if ((((*s_objet_argument_1).type == ALG) &&
! 1880: ((*s_objet_argument_2).type == ALG)) ||
! 1881: (((*s_objet_argument_1).type == RPN) &&
! 1882: ((*s_objet_argument_2).type == RPN)))
! 1883: {
! 1884: nombre_elements = 0;
! 1885: l_element_courant = (struct_liste_chainee *)
! 1886: (*s_objet_argument_1).objet;
! 1887:
! 1888: while(l_element_courant != NULL)
! 1889: {
! 1890: nombre_elements++;
! 1891: l_element_courant = (*l_element_courant).suivant;
! 1892: }
! 1893:
! 1894: if (nombre_elements == 2)
! 1895: {
! 1896: liberation(s_etat_processus, s_objet_argument_1);
! 1897: liberation(s_etat_processus, s_objet_argument_2);
! 1898:
! 1899: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
! 1900: return;
! 1901: }
! 1902:
! 1903: nombre_elements = 0;
! 1904: l_element_courant = (struct_liste_chainee *)
! 1905: (*s_objet_argument_2).objet;
! 1906:
! 1907: while(l_element_courant != NULL)
! 1908: {
! 1909: nombre_elements++;
! 1910: l_element_courant = (*l_element_courant).suivant;
! 1911: }
! 1912:
! 1913: if (nombre_elements == 2)
! 1914: {
! 1915: liberation(s_etat_processus, s_objet_argument_1);
! 1916: liberation(s_etat_processus, s_objet_argument_2);
! 1917:
! 1918: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
! 1919: return;
! 1920: }
! 1921:
! 1922: if ((s_copie_argument_1 = copie_objet(s_etat_processus,
! 1923: s_objet_argument_1, 'N')) == NULL)
! 1924: {
! 1925: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1926: return;
! 1927: }
! 1928:
! 1929: if ((s_copie_argument_2 = copie_objet(s_etat_processus,
! 1930: s_objet_argument_2, 'N')) == NULL)
! 1931: {
! 1932: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1933: return;
! 1934: }
! 1935:
! 1936: l_element_courant = (struct_liste_chainee *)
! 1937: (*s_copie_argument_1).objet;
! 1938: (*s_copie_argument_1).objet = (*((struct_liste_chainee *)
! 1939: (*s_copie_argument_1).objet)).suivant;
! 1940:
! 1941: liberation(s_etat_processus, (*l_element_courant).donnee);
! 1942: free(l_element_courant);
! 1943:
! 1944: l_element_courant = (struct_liste_chainee *)
! 1945: (*s_copie_argument_2).objet;
! 1946: l_element_precedent = l_element_courant;
! 1947: s_objet_resultat = s_copie_argument_2;
! 1948:
! 1949: while((*l_element_courant).suivant != NULL)
! 1950: {
! 1951: l_element_precedent = l_element_courant;
! 1952: l_element_courant = (*l_element_courant).suivant;
! 1953: }
! 1954:
! 1955: liberation(s_etat_processus, (*l_element_courant).donnee);
! 1956: free(l_element_courant);
! 1957:
! 1958: (*l_element_precedent).suivant = (struct_liste_chainee *)
! 1959: (*s_copie_argument_1).objet;
! 1960: free(s_copie_argument_1);
! 1961:
! 1962: l_element_courant = (*l_element_precedent).suivant;
! 1963: while((*l_element_courant).suivant != NULL)
! 1964: {
! 1965: l_element_precedent = l_element_courant;
! 1966: l_element_courant = (*l_element_courant).suivant;
! 1967: }
! 1968:
! 1969: if (((*l_element_precedent).suivant =
! 1970: allocation_maillon(s_etat_processus)) == NULL)
! 1971: {
! 1972: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1973: return;
! 1974: }
! 1975:
! 1976: (*(*l_element_precedent).suivant).suivant = l_element_courant;
! 1977: l_element_courant = (*l_element_precedent).suivant;
! 1978:
! 1979: if (((*l_element_courant).donnee =
! 1980: allocation(s_etat_processus, FCT)) == NULL)
! 1981: {
! 1982: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1983: return;
! 1984: }
! 1985:
! 1986: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1987: .nombre_arguments = 0;
! 1988: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1989: .fonction = instruction_division;
! 1990:
! 1991: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1992: .nom_fonction = malloc(2 * sizeof(unsigned char))) == NULL)
! 1993: {
! 1994: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1995: return;
! 1996: }
! 1997:
! 1998: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1999: .nom_fonction, "/");
! 2000: }
! 2001:
! 2002: /*
! 2003: --------------------------------------------------------------------------------
! 2004: Division d'un vecteur par un scalaire
! 2005: --------------------------------------------------------------------------------
! 2006: */
! 2007: /*
! 2008: * Vecteur d'entiers ou de réels / Entier ou réel
! 2009: */
! 2010:
! 2011: else if ((((*s_objet_argument_1).type == INT) ||
! 2012: ((*s_objet_argument_1).type == REL)) &&
! 2013: (((*s_objet_argument_2).type == VIN) ||
! 2014: ((*s_objet_argument_2).type == VRL)))
! 2015: {
! 2016: resultat_entier = d_faux;
! 2017:
! 2018: if (((*s_objet_argument_2).type == VIN) &&
! 2019: ((*s_objet_argument_1).type == INT))
! 2020: {
! 2021: if ((*((integer8 *) (*s_objet_argument_1).objet)) == 0)
! 2022: {
! 2023: resultat_entier = d_faux;
! 2024: }
! 2025: else
! 2026: {
! 2027: resultat_entier = d_vrai;
! 2028:
! 2029: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_argument_2)
! 2030: .objet))).taille; i++)
! 2031: {
! 2032: if ((((integer8 *) (*((struct_vecteur *)
! 2033: (*s_objet_argument_2).objet)).tableau)[i] %
! 2034: (*((integer8 *) (*s_objet_argument_1).objet))) != 0)
! 2035: {
! 2036: resultat_entier = d_faux;
! 2037: }
! 2038: }
! 2039: }
! 2040: }
! 2041:
! 2042: if (resultat_entier == d_vrai)
! 2043: {
! 2044: if ((s_objet_resultat = allocation(s_etat_processus, VIN))
! 2045: == NULL)
! 2046: {
! 2047: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2048: return;
! 2049: }
! 2050:
! 2051: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
! 2052: (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille;
! 2053:
! 2054: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
! 2055: malloc((*(((struct_vecteur *) (*s_objet_resultat)
! 2056: .objet))).taille * sizeof(integer8))) == NULL)
! 2057: {
! 2058: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2059: return;
! 2060: }
! 2061:
! 2062: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_resultat)
! 2063: .objet))).taille; i++)
! 2064: {
! 2065: ((integer8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
! 2066: .tableau)[i] = ((integer8 *)
! 2067: (*((struct_vecteur *) (*s_objet_argument_2).objet))
! 2068: .tableau)[i] / (*((integer8 *) (*s_objet_argument_1)
! 2069: .objet));
! 2070: }
! 2071: }
! 2072: else
! 2073: {
! 2074: if ((s_objet_resultat = allocation(s_etat_processus, VRL))
! 2075: == NULL)
! 2076: {
! 2077: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2078: return;
! 2079: }
! 2080:
! 2081: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
! 2082: (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille;
! 2083:
! 2084: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
! 2085: malloc((*(((struct_vecteur *) (*s_objet_resultat)
! 2086: .objet))).taille * sizeof(real8))) == NULL)
! 2087: {
! 2088: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2089: return;
! 2090: }
! 2091:
! 2092: if ((*s_objet_argument_1).type == INT)
! 2093: {
! 2094: diviseur_reel = (real8) (*((integer8 *)
! 2095: (*s_objet_argument_1).objet));
! 2096: }
! 2097: else
! 2098: {
! 2099: diviseur_reel = (*((real8 *) (*s_objet_argument_1).objet));
! 2100: }
! 2101:
! 2102: if ((diviseur_reel == 0) && (test_cfsf(s_etat_processus, 59) ==
! 2103: d_vrai))
! 2104: {
! 2105: liberation(s_etat_processus, s_objet_argument_1);
! 2106: liberation(s_etat_processus, s_objet_argument_2);
! 2107: liberation(s_etat_processus, s_objet_resultat);
! 2108:
! 2109: (*s_etat_processus).exception = d_ep_division_par_zero;
! 2110: return;
! 2111: }
! 2112:
! 2113: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_resultat)
! 2114: .objet))).taille; i++)
! 2115: {
! 2116: if ((*s_objet_argument_2).type == VIN)
! 2117: {
! 2118: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
! 2119: .tableau)[i] = (real8) ((integer8 *)
! 2120: (*((struct_vecteur *) (*s_objet_argument_2).objet))
! 2121: .tableau)[i] / diviseur_reel;
! 2122: }
! 2123: else
! 2124: {
! 2125: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
! 2126: .tableau)[i] = ((real8 *)
! 2127: (*((struct_vecteur *) (*s_objet_argument_2).objet))
! 2128: .tableau)[i] / diviseur_reel;
! 2129: }
! 2130: }
! 2131: }
! 2132: }
! 2133:
! 2134: /*
! 2135: * Vecteur d'entiers ou de réels / Complexe
! 2136: */
! 2137:
! 2138: else if (((*s_objet_argument_1).type == CPL) &&
! 2139: (((*s_objet_argument_2).type == VIN) ||
! 2140: ((*s_objet_argument_2).type == VRL)))
! 2141: {
! 2142: if ((s_objet_resultat = allocation(s_etat_processus, VCX)) == NULL)
! 2143: {
! 2144: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2145: return;
! 2146: }
! 2147:
! 2148: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
! 2149: (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille;
! 2150:
! 2151: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
! 2152: malloc((*(((struct_vecteur *) (*s_objet_resultat)
! 2153: .objet))).taille * sizeof(struct_complexe16))) == NULL)
! 2154: {
! 2155: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2156: return;
! 2157: }
! 2158:
! 2159: if (((*((struct_complexe16 *) (*s_objet_argument_1).objet))
! 2160: .partie_reelle == 0) && (((*((struct_complexe16 *)
! 2161: (*s_objet_argument_1).objet)).partie_imaginaire == 0)))
! 2162: {
! 2163: liberation(s_etat_processus, s_objet_argument_1);
! 2164: liberation(s_etat_processus, s_objet_argument_2);
! 2165: liberation(s_etat_processus, s_objet_resultat);
! 2166:
! 2167: (*s_etat_processus).exception = d_ep_division_par_zero;
! 2168: return;
! 2169: }
! 2170:
! 2171: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_resultat)
! 2172: .objet))).taille; i++)
! 2173: {
! 2174: if ((*s_objet_argument_2).type == VIN)
! 2175: {
! 2176: f77divisionic_(&(((integer8 *)
! 2177: (*((struct_vecteur *) (*s_objet_argument_2).objet))
! 2178: .tableau)[i]), &(*((struct_complexe16 *)
! 2179: (*s_objet_argument_1).objet)), &((struct_complexe16 *)
! 2180: (*((struct_vecteur *)
! 2181: (*s_objet_resultat).objet)).tableau)[i]);
! 2182: }
! 2183: else
! 2184: {
! 2185: f77divisionrc_(&(((real8 *)
! 2186: (*((struct_vecteur *) (*s_objet_argument_2).objet))
! 2187: .tableau)[i]), &(*((struct_complexe16 *)
! 2188: (*s_objet_argument_1).objet)), &((struct_complexe16 *)
! 2189: (*((struct_vecteur *)
! 2190: (*s_objet_resultat).objet)).tableau)[i]);
! 2191: }
! 2192: }
! 2193: }
! 2194:
! 2195: /*
! 2196: * Vecteur de complexes / Entier, réel
! 2197: */
! 2198:
! 2199: else if ((((*s_objet_argument_1).type == INT) ||
! 2200: ((*s_objet_argument_1).type == REL)) &&
! 2201: ((*s_objet_argument_2).type == VCX))
! 2202: {
! 2203: if ((s_objet_resultat = allocation(s_etat_processus, VCX)) == NULL)
! 2204: {
! 2205: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2206: return;
! 2207: }
! 2208:
! 2209: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
! 2210: (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille;
! 2211:
! 2212: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
! 2213: malloc((*(((struct_vecteur *) (*s_objet_resultat)
! 2214: .objet))).taille * sizeof(struct_complexe16))) == NULL)
! 2215: {
! 2216: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2217: return;
! 2218: }
! 2219:
! 2220: if ((*s_objet_argument_1).type == INT)
! 2221: {
! 2222: diviseur_reel = (real8) (*((integer8 *)
! 2223: (*s_objet_argument_1).objet));
! 2224: }
! 2225: else
! 2226: {
! 2227: diviseur_reel = (*((real8 *) (*s_objet_argument_1).objet));
! 2228: }
! 2229:
! 2230: if (diviseur_reel == 0)
! 2231: {
! 2232: liberation(s_etat_processus, s_objet_argument_1);
! 2233: liberation(s_etat_processus, s_objet_argument_2);
! 2234: liberation(s_etat_processus, s_objet_resultat);
! 2235:
! 2236: (*s_etat_processus).exception = d_ep_division_par_zero;
! 2237: return;
! 2238: }
! 2239:
! 2240: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_resultat)
! 2241: .objet))).taille; i++)
! 2242: {
! 2243: if ((*s_objet_argument_1).type == INT)
! 2244: {
! 2245: f77divisionci_(&(((struct_complexe16 *)
! 2246: (*((struct_vecteur *) (*s_objet_argument_2).objet))
! 2247: .tableau)[i]), &((*((integer8 *)
! 2248: (*s_objet_argument_1).objet))),
! 2249: &(((struct_complexe16 *) (*((struct_vecteur *)
! 2250: (*s_objet_resultat).objet)).tableau)[i]));
! 2251: }
! 2252: else
! 2253: {
! 2254: f77divisioncr_(&(((struct_complexe16 *)
! 2255: (*((struct_vecteur *) (*s_objet_argument_2).objet))
! 2256: .tableau)[i]), &((*((real8 *)
! 2257: (*s_objet_argument_1).objet))),
! 2258: &(((struct_complexe16 *) (*((struct_vecteur *)
! 2259: (*s_objet_resultat).objet)).tableau)[i]));
! 2260: }
! 2261: }
! 2262: }
! 2263:
! 2264: /*
! 2265: * Vecteur de complexes / Complexe
! 2266: */
! 2267:
! 2268: else if (((*s_objet_argument_1).type == CPL) &&
! 2269: ((*s_objet_argument_2).type == VCX))
! 2270: {
! 2271: if ((s_objet_resultat = allocation(s_etat_processus, VCX)) == NULL)
! 2272: {
! 2273: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2274: return;
! 2275: }
! 2276:
! 2277: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
! 2278: (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille;
! 2279:
! 2280: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
! 2281: malloc((*(((struct_vecteur *) (*s_objet_resultat)
! 2282: .objet))).taille * sizeof(struct_complexe16))) == NULL)
! 2283: {
! 2284: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2285: return;
! 2286: }
! 2287:
! 2288: if (((*((struct_complexe16 *) (*s_objet_argument_1).objet))
! 2289: .partie_reelle == 0) && ((*((struct_complexe16 *)
! 2290: (*s_objet_argument_1).objet)).partie_imaginaire == 0))
! 2291: {
! 2292: liberation(s_etat_processus, s_objet_argument_1);
! 2293: liberation(s_etat_processus, s_objet_argument_2);
! 2294: liberation(s_etat_processus, s_objet_resultat);
! 2295:
! 2296: (*s_etat_processus).exception = d_ep_division_par_zero;
! 2297: return;
! 2298: }
! 2299:
! 2300: for(i = 0; i < (*(((struct_vecteur *) (*s_objet_resultat)
! 2301: .objet))).taille; i++)
! 2302: {
! 2303: f77divisioncc_(&(((struct_complexe16 *)
! 2304: (*((struct_vecteur *) (*s_objet_argument_2).objet))
! 2305: .tableau)[i]), &((*((struct_complexe16 *)
! 2306: (*s_objet_argument_1).objet))),
! 2307: &(((struct_complexe16 *) (*((struct_vecteur *)
! 2308: (*s_objet_resultat).objet)).tableau)[i]));
! 2309: }
! 2310: }
! 2311:
! 2312: /*
! 2313: --------------------------------------------------------------------------------
! 2314: Division d'une matrice par un scalaire
! 2315: --------------------------------------------------------------------------------
! 2316: */
! 2317: /*
! 2318: * Matrice d'entiers ou de réels / Entier ou réel
! 2319: */
! 2320:
! 2321: else if ((((*s_objet_argument_1).type == INT) ||
! 2322: ((*s_objet_argument_1).type == REL)) &&
! 2323: (((*s_objet_argument_2).type == MIN) ||
! 2324: ((*s_objet_argument_2).type == MRL)))
! 2325: {
! 2326: resultat_entier = d_faux;
! 2327:
! 2328: if (((*s_objet_argument_2).type == MIN) &&
! 2329: ((*s_objet_argument_1).type == INT))
! 2330: {
! 2331: if ((*((integer8 *) (*s_objet_argument_1).objet)) == 0)
! 2332: {
! 2333: resultat_entier = d_faux;
! 2334: }
! 2335: else
! 2336: {
! 2337: resultat_entier = d_vrai;
! 2338:
! 2339: for(i = 0; i < (*(((struct_matrice *) (*s_objet_argument_2)
! 2340: .objet))).nombre_lignes; i++)
! 2341: {
! 2342: for(j = 0; j < (*(((struct_matrice *) (*s_objet_argument_2)
! 2343: .objet))).nombre_colonnes; j++)
! 2344: {
! 2345: if ((((integer8 **) (*((struct_matrice *)
! 2346: (*s_objet_argument_2).objet)).tableau)[i][j] %
! 2347: (*((integer8 *) (*s_objet_argument_1).objet)))
! 2348: != 0)
! 2349: {
! 2350: resultat_entier = d_faux;
! 2351: }
! 2352: }
! 2353: }
! 2354: }
! 2355: }
! 2356:
! 2357: if (resultat_entier == d_vrai)
! 2358: {
! 2359: if ((s_objet_resultat = allocation(s_etat_processus, MIN))
! 2360: == NULL)
! 2361: {
! 2362: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2363: return;
! 2364: }
! 2365:
! 2366: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
! 2367: (*((struct_matrice *) (*s_objet_argument_2).objet))
! 2368: .nombre_lignes;
! 2369: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
! 2370: (*((struct_matrice *) (*s_objet_argument_2).objet))
! 2371: .nombre_colonnes;
! 2372:
! 2373: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
! 2374: malloc((*(((struct_matrice *) (*s_objet_resultat)
! 2375: .objet))).nombre_lignes * sizeof(integer8 *))) == NULL)
! 2376: {
! 2377: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2378: return;
! 2379: }
! 2380:
! 2381: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
! 2382: .objet))).nombre_lignes; i++)
! 2383: {
! 2384: if ((((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
! 2385: .objet)).tableau)[i] = malloc((*(((struct_matrice *)
! 2386: (*s_objet_resultat).objet))).nombre_colonnes *
! 2387: sizeof(integer8))) == NULL)
! 2388: {
! 2389: (*s_etat_processus).erreur_systeme =
! 2390: d_es_allocation_memoire;
! 2391: return;
! 2392: }
! 2393:
! 2394: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat)
! 2395: .objet))).nombre_colonnes; j++)
! 2396: {
! 2397: ((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
! 2398: .objet)).tableau)[i][j] = ((integer8 **)
! 2399: (*((struct_matrice *) (*s_objet_argument_2)
! 2400: .objet)).tableau)[i][j] / (*((integer8 *)
! 2401: (*s_objet_argument_1).objet));
! 2402: }
! 2403: }
! 2404: }
! 2405: else
! 2406: {
! 2407: if ((s_objet_resultat = allocation(s_etat_processus, MRL))
! 2408: == NULL)
! 2409: {
! 2410: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2411: return;
! 2412: }
! 2413:
! 2414: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
! 2415: (*((struct_matrice *) (*s_objet_argument_2).objet))
! 2416: .nombre_lignes;
! 2417: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
! 2418: (*((struct_matrice *) (*s_objet_argument_2).objet))
! 2419: .nombre_colonnes;
! 2420:
! 2421: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
! 2422: malloc((*(((struct_matrice *) (*s_objet_resultat)
! 2423: .objet))).nombre_lignes * sizeof(real8 *))) == NULL)
! 2424: {
! 2425: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2426: return;
! 2427: }
! 2428:
! 2429: if ((*s_objet_argument_1).type == INT)
! 2430: {
! 2431: diviseur_reel = (real8) (*((integer8 *)
! 2432: (*s_objet_argument_1).objet));
! 2433: }
! 2434: else
! 2435: {
! 2436: diviseur_reel = (*((real8 *) (*s_objet_argument_1).objet));
! 2437: }
! 2438:
! 2439: if ((diviseur_reel == 0) && (test_cfsf(s_etat_processus, 59) ==
! 2440: d_vrai))
! 2441: {
! 2442: liberation(s_etat_processus, s_objet_argument_1);
! 2443: liberation(s_etat_processus, s_objet_argument_2);
! 2444: liberation(s_etat_processus, s_objet_resultat);
! 2445:
! 2446: (*s_etat_processus).exception = d_ep_division_par_zero;
! 2447: return;
! 2448: }
! 2449:
! 2450: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
! 2451: .objet))).nombre_lignes; i++)
! 2452: {
! 2453: if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat)
! 2454: .objet)).tableau)[i] = malloc((*(((struct_matrice *)
! 2455: (*s_objet_resultat).objet))).nombre_colonnes *
! 2456: sizeof(real8))) == NULL)
! 2457: {
! 2458: (*s_etat_processus).erreur_systeme =
! 2459: d_es_allocation_memoire;
! 2460: return;
! 2461: }
! 2462:
! 2463: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat)
! 2464: .objet))).nombre_colonnes; j++)
! 2465: {
! 2466: if ((*s_objet_argument_2).type == MIN)
! 2467: {
! 2468: ((real8 **) (*((struct_matrice *) (*s_objet_resultat)
! 2469: .objet)).tableau)[i][j] = (real8) ((integer8 **)
! 2470: (*((struct_matrice *) (*s_objet_argument_2)
! 2471: .objet)).tableau)[i][j] / diviseur_reel;
! 2472: }
! 2473: else
! 2474: {
! 2475: ((real8 **) (*((struct_matrice *) (*s_objet_resultat)
! 2476: .objet)).tableau)[i][j] = ((real8 **)
! 2477: (*((struct_matrice *) (*s_objet_argument_2)
! 2478: .objet)).tableau)[i][j] / diviseur_reel;
! 2479: }
! 2480: }
! 2481: }
! 2482: }
! 2483: }
! 2484:
! 2485: /*
! 2486: * Matrice d'entiers ou de réels / Complexe
! 2487: */
! 2488:
! 2489: else if (((*s_objet_argument_1).type == CPL) &&
! 2490: (((*s_objet_argument_2).type == MIN) ||
! 2491: ((*s_objet_argument_2).type == MRL)))
! 2492: {
! 2493: if ((s_objet_resultat = allocation(s_etat_processus, MCX)) == NULL)
! 2494: {
! 2495: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2496: return;
! 2497: }
! 2498:
! 2499: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
! 2500: (*((struct_matrice *) (*s_objet_argument_2).objet))
! 2501: .nombre_lignes;
! 2502: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
! 2503: (*((struct_matrice *) (*s_objet_argument_2).objet))
! 2504: .nombre_colonnes;
! 2505:
! 2506: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
! 2507: malloc((*(((struct_matrice *) (*s_objet_resultat)
! 2508: .objet))).nombre_lignes * sizeof(struct_complexe16 *))) == NULL)
! 2509: {
! 2510: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2511: return;
! 2512: }
! 2513:
! 2514: if (((*((struct_complexe16 *) (*s_objet_argument_1).objet))
! 2515: .partie_reelle == 0) && (((*((struct_complexe16 *)
! 2516: (*s_objet_argument_1).objet)).partie_imaginaire == 0)))
! 2517: {
! 2518: liberation(s_etat_processus, s_objet_argument_1);
! 2519: liberation(s_etat_processus, s_objet_argument_2);
! 2520: liberation(s_etat_processus, s_objet_resultat);
! 2521:
! 2522: (*s_etat_processus).exception = d_ep_division_par_zero;
! 2523: return;
! 2524: }
! 2525:
! 2526: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
! 2527: .objet))).nombre_lignes; i++)
! 2528: {
! 2529: if ((((struct_complexe16 **) (*((struct_matrice *)
! 2530: (*s_objet_resultat).objet)).tableau)[i] =
! 2531: malloc((*(((struct_matrice *)
! 2532: (*s_objet_resultat).objet))).nombre_colonnes *
! 2533: sizeof(struct_complexe16))) == NULL)
! 2534: {
! 2535: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2536: return;
! 2537: }
! 2538:
! 2539: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat)
! 2540: .objet))).nombre_colonnes; j++)
! 2541: {
! 2542: if ((*s_objet_argument_2).type == MIN)
! 2543: {
! 2544: f77divisionic_(&(((integer8 **)
! 2545: (*((struct_matrice *) (*s_objet_argument_2).objet))
! 2546: .tableau)[i][j]), &(*((struct_complexe16 *)
! 2547: (*s_objet_argument_1).objet)),
! 2548: &((struct_complexe16 **) (*((struct_matrice *)
! 2549: (*s_objet_resultat).objet)).tableau)[i][j]);
! 2550: }
! 2551: else
! 2552: {
! 2553: f77divisionrc_(&(((real8 **)
! 2554: (*((struct_matrice *) (*s_objet_argument_2).objet))
! 2555: .tableau)[i][j]), &(*((struct_complexe16 *)
! 2556: (*s_objet_argument_1).objet)),
! 2557: &((struct_complexe16 **) (*((struct_matrice *)
! 2558: (*s_objet_resultat).objet)).tableau)[i][j]);
! 2559: }
! 2560: }
! 2561: }
! 2562: }
! 2563:
! 2564: /*
! 2565: * Matrice de complexes / Entier, réel
! 2566: */
! 2567:
! 2568: else if ((((*s_objet_argument_1).type == INT) ||
! 2569: ((*s_objet_argument_1).type == REL)) &&
! 2570: ((*s_objet_argument_2).type == MCX))
! 2571: {
! 2572: if ((s_objet_resultat = allocation(s_etat_processus, MCX)) == NULL)
! 2573: {
! 2574: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2575: return;
! 2576: }
! 2577:
! 2578: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
! 2579: (*((struct_matrice *) (*s_objet_argument_2).objet))
! 2580: .nombre_lignes;
! 2581: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
! 2582: (*((struct_matrice *) (*s_objet_argument_2).objet))
! 2583: .nombre_colonnes;
! 2584:
! 2585: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
! 2586: malloc((*(((struct_matrice *) (*s_objet_resultat)
! 2587: .objet))).nombre_lignes * sizeof(struct_complexe16 *))) == NULL)
! 2588: {
! 2589: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2590: return;
! 2591: }
! 2592:
! 2593: if ((*s_objet_argument_1).type == INT)
! 2594: {
! 2595: diviseur_reel = (real8) (*((integer8 *)
! 2596: (*s_objet_argument_1).objet));
! 2597: }
! 2598: else
! 2599: {
! 2600: diviseur_reel = (*((real8 *) (*s_objet_argument_1).objet));
! 2601: }
! 2602:
! 2603: if (diviseur_reel == 0)
! 2604: {
! 2605: liberation(s_etat_processus, s_objet_argument_1);
! 2606: liberation(s_etat_processus, s_objet_argument_2);
! 2607: liberation(s_etat_processus, s_objet_resultat);
! 2608:
! 2609: (*s_etat_processus).exception = d_ep_division_par_zero;
! 2610: return;
! 2611: }
! 2612:
! 2613: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
! 2614: .objet))).nombre_lignes; i++)
! 2615: {
! 2616: if ((((struct_complexe16 **) (*((struct_matrice *)
! 2617: (*s_objet_resultat).objet)).tableau)[i] =
! 2618: malloc((*(((struct_matrice *)
! 2619: (*s_objet_resultat).objet))).nombre_colonnes *
! 2620: sizeof(struct_complexe16))) == NULL)
! 2621: {
! 2622: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2623: return;
! 2624: }
! 2625:
! 2626: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat)
! 2627: .objet))).nombre_colonnes; j++)
! 2628: {
! 2629: if ((*s_objet_argument_1).type == INT)
! 2630: {
! 2631: f77divisionci_(&(((struct_complexe16 **)
! 2632: (*((struct_matrice *) (*s_objet_argument_2).objet))
! 2633: .tableau)[i][j]), &((*((integer8 *)
! 2634: (*s_objet_argument_1).objet))),
! 2635: &(((struct_complexe16 **) (*((struct_matrice *)
! 2636: (*s_objet_resultat).objet)).tableau)[i][j]));
! 2637: }
! 2638: else
! 2639: {
! 2640: f77divisioncr_(&(((struct_complexe16 **)
! 2641: (*((struct_matrice *) (*s_objet_argument_2).objet))
! 2642: .tableau)[i][j]), &((*((real8 *)
! 2643: (*s_objet_argument_1).objet))),
! 2644: &(((struct_complexe16 **) (*((struct_matrice *)
! 2645: (*s_objet_resultat).objet)).tableau)[i][j]));
! 2646: }
! 2647: }
! 2648: }
! 2649: }
! 2650:
! 2651: /*
! 2652: * Matrice de complexes / Complexe
! 2653: */
! 2654:
! 2655: else if (((*s_objet_argument_1).type == CPL) &&
! 2656: ((*s_objet_argument_2).type == MCX))
! 2657: {
! 2658: if ((s_objet_resultat = allocation(s_etat_processus, MCX)) == NULL)
! 2659: {
! 2660: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2661: return;
! 2662: }
! 2663:
! 2664: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
! 2665: (*((struct_matrice *) (*s_objet_argument_2).objet))
! 2666: .nombre_lignes;
! 2667: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
! 2668: (*((struct_matrice *) (*s_objet_argument_2).objet))
! 2669: .nombre_colonnes;
! 2670:
! 2671: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
! 2672: malloc((*(((struct_matrice *) (*s_objet_resultat)
! 2673: .objet))).nombre_lignes * sizeof(struct_complexe16 *))) == NULL)
! 2674: {
! 2675: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2676: return;
! 2677: }
! 2678:
! 2679: if (((*((struct_complexe16 *) (*s_objet_argument_1).objet))
! 2680: .partie_reelle == 0) && ((*((struct_complexe16 *)
! 2681: (*s_objet_argument_1).objet)).partie_imaginaire == 0))
! 2682: {
! 2683: liberation(s_etat_processus, s_objet_argument_1);
! 2684: liberation(s_etat_processus, s_objet_argument_2);
! 2685: liberation(s_etat_processus, s_objet_resultat);
! 2686:
! 2687: (*s_etat_processus).exception = d_ep_division_par_zero;
! 2688: return;
! 2689: }
! 2690:
! 2691: for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
! 2692: .objet))).nombre_lignes; i++)
! 2693: {
! 2694: if ((((struct_complexe16 **) (*((struct_matrice *)
! 2695: (*s_objet_resultat).objet)).tableau)[i] =
! 2696: malloc((*(((struct_matrice *)
! 2697: (*s_objet_resultat).objet))).nombre_colonnes *
! 2698: sizeof(struct_complexe16))) == NULL)
! 2699: {
! 2700: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2701: return;
! 2702: }
! 2703:
! 2704: for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat)
! 2705: .objet))).nombre_colonnes; j++)
! 2706: {
! 2707: f77divisioncc_(&(((struct_complexe16 **)
! 2708: (*((struct_matrice *) (*s_objet_argument_2).objet))
! 2709: .tableau)[i][j]), &((*((struct_complexe16 *)
! 2710: (*s_objet_argument_1).objet))),
! 2711: &(((struct_complexe16 **) (*((struct_matrice *)
! 2712: (*s_objet_resultat).objet)).tableau)[i][j]));
! 2713: }
! 2714: }
! 2715: }
! 2716:
! 2717: /*
! 2718: --------------------------------------------------------------------------------
! 2719: Division mettant en oeuvre une inversion de matrice
! 2720: --------------------------------------------------------------------------------
! 2721: */
! 2722: /*
! 2723: * Vecteur d'entiers ou de réels / Matrice d'entiers ou de réels
! 2724: */
! 2725:
! 2726: else if ((((*s_objet_argument_1).type == MIN) ||
! 2727: ((*s_objet_argument_1).type == MRL)) &&
! 2728: (((*s_objet_argument_2).type == VIN) ||
! 2729: ((*s_objet_argument_2).type == VRL)))
! 2730: {
! 2731: if ((*s_objet_argument_1).type == MIN)
! 2732: {
! 2733: (*s_objet_argument_1).type = MRL;
! 2734: }
! 2735:
! 2736: if ((*(((struct_matrice *) (*s_objet_argument_1).objet)))
! 2737: .nombre_colonnes != (*(((struct_vecteur *)
! 2738: (*s_objet_argument_2).objet))).taille)
! 2739: {
! 2740: liberation(s_etat_processus, s_objet_argument_1);
! 2741: liberation(s_etat_processus, s_objet_argument_2);
! 2742:
! 2743: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
! 2744: return;
! 2745: }
! 2746:
! 2747: if ((s_objet_resultat = allocation(s_etat_processus, VRL)) == NULL)
! 2748: {
! 2749: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2750: return;
! 2751: }
! 2752:
! 2753: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
! 2754: (*(((struct_vecteur *) (*s_objet_argument_2)
! 2755: .objet))).taille;
! 2756:
! 2757: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
! 2758: malloc((*((struct_vecteur *)
! 2759: (*s_objet_resultat).objet)).taille * sizeof(real8))) == NULL)
! 2760: {
! 2761: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2762: return;
! 2763: }
! 2764:
! 2765: if ((*(((struct_matrice *) (*s_objet_argument_1).objet))).nombre_lignes
! 2766: != (*(((struct_matrice *) (*s_objet_argument_1).objet)))
! 2767: .nombre_colonnes)
! 2768: {
! 2769: liberation(s_etat_processus, s_objet_argument_1);
! 2770: liberation(s_etat_processus, s_objet_argument_2);
! 2771: liberation(s_etat_processus, s_objet_resultat);
! 2772:
! 2773: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
! 2774: return;
! 2775: }
! 2776:
! 2777: inversion_matrice(s_etat_processus,
! 2778: (struct_matrice *) (*s_objet_argument_1).objet);
! 2779:
! 2780: if (((*s_etat_processus).exception != d_ep) ||
! 2781: ((*s_etat_processus).erreur_execution != d_ex))
! 2782: {
! 2783: liberation(s_etat_processus, s_objet_argument_1);
! 2784: liberation(s_etat_processus, s_objet_argument_2);
! 2785: liberation(s_etat_processus, s_objet_resultat);
! 2786: return;
! 2787: }
! 2788:
! 2789: if ((*s_etat_processus).erreur_systeme != d_es)
! 2790: {
! 2791: return;
! 2792: }
! 2793:
! 2794: for(i = 0; i < (*((struct_vecteur *)
! 2795: (*s_objet_resultat).objet)).taille; i++)
! 2796: {
! 2797: ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
! 2798: .tableau)[i] = 0;
! 2799:
! 2800: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_1).objet))
! 2801: .nombre_colonnes; j++)
! 2802: {
! 2803: if ((*s_objet_argument_2).type == VIN)
! 2804: {
! 2805: ((real8 *) (*((struct_vecteur *)
! 2806: (*s_objet_resultat).objet))
! 2807: .tableau)[i] += ((real8 **) (*((struct_matrice *)
! 2808: (*s_objet_argument_1).objet)).tableau)[i][j] *
! 2809: ((integer8 *) (*((struct_vecteur *)
! 2810: (*s_objet_argument_2).objet)).tableau)[j];
! 2811: }
! 2812: else
! 2813: {
! 2814: ((real8 *) (*((struct_vecteur *)
! 2815: (*s_objet_resultat).objet))
! 2816: .tableau)[i] += ((real8 **) (*((struct_matrice *)
! 2817: (*s_objet_argument_1).objet)).tableau)[i][j] *
! 2818: ((real8 *) (*((struct_vecteur *)
! 2819: (*s_objet_argument_2).objet)).tableau)[j];
! 2820: }
! 2821: }
! 2822: }
! 2823: }
! 2824:
! 2825: /*
! 2826: * Vecteur d'entiers ou de réels / Matrice de complexes
! 2827: */
! 2828:
! 2829: else if (((*s_objet_argument_1).type == MCX) &&
! 2830: (((*s_objet_argument_2).type == VIN) ||
! 2831: ((*s_objet_argument_2).type == VRL)))
! 2832: {
! 2833: if ((*(((struct_matrice *) (*s_objet_argument_1).objet)))
! 2834: .nombre_colonnes != (*(((struct_vecteur *)
! 2835: (*s_objet_argument_2).objet))).taille)
! 2836: {
! 2837: liberation(s_etat_processus, s_objet_argument_1);
! 2838: liberation(s_etat_processus, s_objet_argument_2);
! 2839:
! 2840: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
! 2841: return;
! 2842: }
! 2843:
! 2844: if ((s_objet_resultat = allocation(s_etat_processus, VCX)) == NULL)
! 2845: {
! 2846: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2847: return;
! 2848: }
! 2849:
! 2850: (*((struct_vecteur *) (*s_objet_resultat).objet)).type = 'C';
! 2851: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
! 2852: (*(((struct_vecteur *) (*s_objet_argument_2)
! 2853: .objet))).taille;
! 2854:
! 2855: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
! 2856: malloc((*((struct_vecteur *)
! 2857: (*s_objet_resultat).objet)).taille * sizeof(struct_complexe16)))
! 2858: == NULL)
! 2859: {
! 2860: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2861: return;
! 2862: }
! 2863:
! 2864: if ((*(((struct_matrice *) (*s_objet_argument_1).objet))).nombre_lignes
! 2865: != (*(((struct_matrice *) (*s_objet_argument_1).objet)))
! 2866: .nombre_colonnes)
! 2867: {
! 2868: liberation(s_etat_processus, s_objet_argument_1);
! 2869: liberation(s_etat_processus, s_objet_argument_2);
! 2870: liberation(s_etat_processus, s_objet_resultat);
! 2871:
! 2872: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
! 2873: return;
! 2874: }
! 2875:
! 2876: inversion_matrice(s_etat_processus,
! 2877: (struct_matrice *) (*s_objet_argument_1).objet);
! 2878:
! 2879: if (((*s_etat_processus).exception != d_ep) ||
! 2880: ((*s_etat_processus).erreur_execution != d_ex))
! 2881: {
! 2882: liberation(s_etat_processus, s_objet_argument_1);
! 2883: liberation(s_etat_processus, s_objet_argument_2);
! 2884: liberation(s_etat_processus, s_objet_resultat);
! 2885: return;
! 2886: }
! 2887:
! 2888: if ((*s_etat_processus).erreur_systeme != d_es)
! 2889: {
! 2890: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2891: return;
! 2892: }
! 2893:
! 2894: for(i = 0; i < (*((struct_vecteur *)
! 2895: (*s_objet_resultat).objet)).taille; i++)
! 2896: {
! 2897: (((struct_complexe16 *) (*((struct_vecteur *)
! 2898: (*s_objet_resultat).objet)).tableau)[i]).partie_reelle = 0;
! 2899: (((struct_complexe16 *) (*((struct_vecteur *)
! 2900: (*s_objet_resultat).objet)).tableau)[i]).partie_imaginaire
! 2901: = 0;
! 2902:
! 2903: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_1).objet))
! 2904: .nombre_colonnes; j++)
! 2905: {
! 2906: if ((*s_objet_argument_2).type == VIN)
! 2907: {
! 2908: f77multiplicationci_(&(((struct_complexe16 **)
! 2909: (*((struct_matrice *) (*s_objet_argument_1).objet))
! 2910: .tableau)[i][j]), &(((integer8 *)
! 2911: (*((struct_vecteur *) (*s_objet_argument_2).objet))
! 2912: .tableau)[j]), &accumulateur);
! 2913:
! 2914: f77additioncc_(&(((struct_complexe16 *)
! 2915: (*((struct_vecteur *) (*s_objet_resultat).objet))
! 2916: .tableau)[i]), &accumulateur,
! 2917: &(((struct_complexe16 *)
! 2918: (*((struct_vecteur *) (*s_objet_resultat).objet))
! 2919: .tableau)[i]));
! 2920: }
! 2921: else
! 2922: {
! 2923: f77multiplicationcr_(&(((struct_complexe16 **)
! 2924: (*((struct_matrice *) (*s_objet_argument_1).objet))
! 2925: .tableau)[i][j]), &(((real8 *)
! 2926: (*((struct_vecteur *) (*s_objet_argument_2).objet))
! 2927: .tableau)[j]), &accumulateur);
! 2928:
! 2929: f77additioncc_(&(((struct_complexe16 *)
! 2930: (*((struct_vecteur *) (*s_objet_resultat).objet))
! 2931: .tableau)[i]), &accumulateur,
! 2932: &(((struct_complexe16 *)
! 2933: (*((struct_vecteur *) (*s_objet_resultat).objet))
! 2934: .tableau)[i]));
! 2935: }
! 2936: }
! 2937: }
! 2938: }
! 2939:
! 2940: /*
! 2941: * Vecteur de complexes / Matrice de complexes
! 2942: */
! 2943:
! 2944: else if (((*s_objet_argument_1).type == MCX) &&
! 2945: ((*s_objet_argument_2).type == VCX))
! 2946: {
! 2947: if ((*(((struct_matrice *) (*s_objet_argument_1).objet)))
! 2948: .nombre_colonnes != (*(((struct_vecteur *)
! 2949: (*s_objet_argument_2).objet))).taille)
! 2950: {
! 2951: liberation(s_etat_processus, s_objet_argument_1);
! 2952: liberation(s_etat_processus, s_objet_argument_2);
! 2953:
! 2954: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
! 2955: return;
! 2956: }
! 2957:
! 2958: if ((s_objet_resultat = allocation(s_etat_processus, VCX)) == NULL)
! 2959: {
! 2960: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2961: return;
! 2962: }
! 2963:
! 2964: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
! 2965: (*(((struct_vecteur *) (*s_objet_argument_2)
! 2966: .objet))).taille;
! 2967:
! 2968: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
! 2969: malloc((*((struct_vecteur *)
! 2970: (*s_objet_resultat).objet)).taille * sizeof(struct_complexe16)))
! 2971: == NULL)
! 2972: {
! 2973: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 2974: return;
! 2975: }
! 2976:
! 2977: if ((*(((struct_matrice *) (*s_objet_argument_1).objet))).nombre_lignes
! 2978: != (*(((struct_matrice *) (*s_objet_argument_1).objet)))
! 2979: .nombre_colonnes)
! 2980: {
! 2981: liberation(s_etat_processus, s_objet_argument_1);
! 2982: liberation(s_etat_processus, s_objet_argument_2);
! 2983: liberation(s_etat_processus, s_objet_resultat);
! 2984:
! 2985: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
! 2986: return;
! 2987: }
! 2988:
! 2989: inversion_matrice(s_etat_processus,
! 2990: (struct_matrice *) (*s_objet_argument_1).objet);
! 2991:
! 2992: if (((*s_etat_processus).exception != d_ep) ||
! 2993: ((*s_etat_processus).erreur_execution != d_ex))
! 2994: {
! 2995: liberation(s_etat_processus, s_objet_argument_1);
! 2996: liberation(s_etat_processus, s_objet_argument_2);
! 2997: liberation(s_etat_processus, s_objet_resultat);
! 2998: return;
! 2999: }
! 3000:
! 3001: if ((*s_etat_processus).erreur_systeme != d_es)
! 3002: {
! 3003: return;
! 3004: }
! 3005:
! 3006: for(i = 0; i < (*((struct_vecteur *)
! 3007: (*s_objet_resultat).objet)).taille; i++)
! 3008: {
! 3009: (((struct_complexe16 *) (*((struct_vecteur *)
! 3010: (*s_objet_resultat).objet)).tableau)[i]).partie_reelle = 0;
! 3011: (((struct_complexe16 *) (*((struct_vecteur *)
! 3012: (*s_objet_resultat).objet)).tableau)[i]).partie_imaginaire
! 3013: = 0;
! 3014:
! 3015: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_1).objet))
! 3016: .nombre_colonnes; j++)
! 3017: {
! 3018: f77multiplicationcc_(&(((struct_complexe16 **)
! 3019: (*((struct_matrice *) (*s_objet_argument_1).objet))
! 3020: .tableau)[i][j]), &(((struct_complexe16 *)
! 3021: (*((struct_vecteur *) (*s_objet_argument_2).objet))
! 3022: .tableau)[j]), &accumulateur);
! 3023:
! 3024: f77additioncc_(&(((struct_complexe16 *)
! 3025: (*((struct_vecteur *) (*s_objet_resultat).objet))
! 3026: .tableau)[i]), &accumulateur,
! 3027: &(((struct_complexe16 *)
! 3028: (*((struct_vecteur *) (*s_objet_resultat).objet))
! 3029: .tableau)[i]));
! 3030: }
! 3031: }
! 3032: }
! 3033:
! 3034: /*
! 3035: * Vecteur de complexes / Matrice d'entiers ou de réels
! 3036: */
! 3037:
! 3038: else if (((*s_objet_argument_2).type == VCX) &&
! 3039: (((*s_objet_argument_1).type == MRL) ||
! 3040: ((*s_objet_argument_1).type == MIN)))
! 3041: {
! 3042: if ((*s_objet_argument_1).type == MIN)
! 3043: {
! 3044: (*s_objet_argument_1).type = MRL;
! 3045: }
! 3046:
! 3047: if ((*(((struct_matrice *) (*s_objet_argument_1).objet)))
! 3048: .nombre_colonnes != (*(((struct_vecteur *)
! 3049: (*s_objet_argument_2).objet))).taille)
! 3050: {
! 3051: liberation(s_etat_processus, s_objet_argument_1);
! 3052: liberation(s_etat_processus, s_objet_argument_2);
! 3053:
! 3054: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
! 3055: return;
! 3056: }
! 3057:
! 3058: if ((s_objet_resultat = allocation(s_etat_processus, VCX)) == NULL)
! 3059: {
! 3060: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 3061: return;
! 3062: }
! 3063:
! 3064: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
! 3065: (*(((struct_vecteur *) (*s_objet_argument_2)
! 3066: .objet))).taille;
! 3067:
! 3068: if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
! 3069: malloc((*((struct_vecteur *)
! 3070: (*s_objet_resultat).objet)).taille * sizeof(struct_complexe16)))
! 3071: == NULL)
! 3072: {
! 3073: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 3074: return;
! 3075: }
! 3076:
! 3077: if ((*(((struct_matrice *) (*s_objet_argument_1).objet))).nombre_lignes
! 3078: != (*(((struct_matrice *) (*s_objet_argument_1).objet)))
! 3079: .nombre_colonnes)
! 3080: {
! 3081: liberation(s_etat_processus, s_objet_argument_1);
! 3082: liberation(s_etat_processus, s_objet_argument_2);
! 3083: liberation(s_etat_processus, s_objet_resultat);
! 3084:
! 3085: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
! 3086: return;
! 3087: }
! 3088:
! 3089: inversion_matrice(s_etat_processus,
! 3090: (struct_matrice *) (*s_objet_argument_1).objet);
! 3091:
! 3092: if (((*s_etat_processus).exception != d_ep) ||
! 3093: ((*s_etat_processus).erreur_execution != d_ex))
! 3094: {
! 3095: liberation(s_etat_processus, s_objet_argument_1);
! 3096: liberation(s_etat_processus, s_objet_argument_2);
! 3097: liberation(s_etat_processus, s_objet_resultat);
! 3098: return;
! 3099: }
! 3100:
! 3101: if ((*s_etat_processus).erreur_systeme != d_es)
! 3102: {
! 3103: return;
! 3104: }
! 3105:
! 3106: for(i = 0; i < (*((struct_vecteur *)
! 3107: (*s_objet_resultat).objet)).taille; i++)
! 3108: {
! 3109: (((struct_complexe16 *) (*((struct_vecteur *)
! 3110: (*s_objet_resultat).objet)).tableau)[i]).partie_reelle = 0;
! 3111: (((struct_complexe16 *) (*((struct_vecteur *)
! 3112: (*s_objet_resultat).objet)).tableau)[i]).partie_imaginaire
! 3113: = 0;
! 3114:
! 3115: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument_1).objet))
! 3116: .nombre_colonnes; j++)
! 3117: {
! 3118: f77multiplicationcr_(&(((struct_complexe16 *)
! 3119: (*((struct_vecteur *) (*s_objet_argument_2).objet))
! 3120: .tableau)[j]), &(((real8 **)
! 3121: (*((struct_matrice *) (*s_objet_argument_1).objet))
! 3122: .tableau)[i][j]), &accumulateur);
! 3123:
! 3124: f77additioncc_(&(((struct_complexe16 *)
! 3125: (*((struct_vecteur *) (*s_objet_resultat).objet))
! 3126: .tableau)[i]), &accumulateur,
! 3127: &(((struct_complexe16 *)
! 3128: (*((struct_vecteur *) (*s_objet_resultat).objet))
! 3129: .tableau)[i]));
! 3130: }
! 3131: }
! 3132: }
! 3133:
! 3134: /*
! 3135: * Matrice d'entiers ou de réels / Matrice d'entiers ou de réels
! 3136: */
! 3137:
! 3138: else if ((((*s_objet_argument_1).type == MIN) ||
! 3139: ((*s_objet_argument_1).type == MRL)) &&
! 3140: (((*s_objet_argument_2).type == MIN) ||
! 3141: ((*s_objet_argument_2).type == MRL)))
! 3142: {
! 3143: if ((*s_objet_argument_1).type == MIN)
! 3144: {
! 3145: (*s_objet_argument_1).type = MRL;
! 3146: }
! 3147:
! 3148: if ((*(((struct_matrice *) (*s_objet_argument_1).objet)))
! 3149: .nombre_colonnes != (*(((struct_matrice *)
! 3150: (*s_objet_argument_2).objet))).nombre_lignes)
! 3151: {
! 3152: liberation(s_etat_processus, s_objet_argument_1);
! 3153: liberation(s_etat_processus, s_objet_argument_2);
! 3154:
! 3155: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
! 3156: return;
! 3157: }
! 3158:
! 3159: if ((s_objet_resultat = allocation(s_etat_processus, MRL)) == NULL)
! 3160: {
! 3161: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 3162: return;
! 3163: }
! 3164:
! 3165: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
! 3166: (*(((struct_matrice *) (*s_objet_argument_2)
! 3167: .objet))).nombre_lignes;
! 3168: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
! 3169: (*(((struct_matrice *) (*s_objet_argument_2)
! 3170: .objet))).nombre_colonnes;
! 3171:
! 3172: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
! 3173: malloc((*((struct_matrice *)
! 3174: (*s_objet_resultat).objet)).nombre_lignes * sizeof(real8 *)))
! 3175: == NULL)
! 3176: {
! 3177: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 3178: return;
! 3179: }
! 3180:
! 3181: if ((*(((struct_matrice *) (*s_objet_argument_1).objet))).nombre_lignes
! 3182: != (*(((struct_matrice *) (*s_objet_argument_1).objet)))
! 3183: .nombre_colonnes)
! 3184: {
! 3185: liberation(s_etat_processus, s_objet_argument_1);
! 3186: liberation(s_etat_processus, s_objet_argument_2);
! 3187: liberation(s_etat_processus, s_objet_resultat);
! 3188:
! 3189: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
! 3190: return;
! 3191: }
! 3192:
! 3193: inversion_matrice(s_etat_processus,
! 3194: (struct_matrice *) (*s_objet_argument_1).objet);
! 3195:
! 3196: if (((*s_etat_processus).exception != d_ep) ||
! 3197: ((*s_etat_processus).erreur_execution != d_ex))
! 3198: {
! 3199: liberation(s_etat_processus, s_objet_argument_1);
! 3200: liberation(s_etat_processus, s_objet_argument_2);
! 3201: liberation(s_etat_processus, s_objet_resultat);
! 3202: return;
! 3203: }
! 3204:
! 3205: if ((*s_etat_processus).erreur_systeme != d_es)
! 3206: {
! 3207: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 3208: return;
! 3209: }
! 3210:
! 3211: for(i = 0; i < (*((struct_matrice *)
! 3212: (*s_objet_resultat).objet)).nombre_lignes; i++)
! 3213: {
! 3214: if ((((*((struct_matrice *) (*s_objet_resultat).objet)).tableau)[i]
! 3215: = malloc((*((struct_matrice *)
! 3216: (*s_objet_resultat).objet)).nombre_colonnes *
! 3217: sizeof(real8))) == NULL)
! 3218: {
! 3219: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 3220: return;
! 3221: }
! 3222:
! 3223: for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat).objet))
! 3224: .nombre_colonnes; j++)
! 3225: {
! 3226: ((real8 **) (*((struct_matrice *) (*s_objet_resultat).objet))
! 3227: .tableau)[i][j] = 0;
! 3228:
! 3229: for(k = 0; k < (*((struct_matrice *) (*s_objet_argument_2)
! 3230: .objet)).nombre_lignes; k++)
! 3231: {
! 3232: if ((*s_objet_argument_2).type == MIN)
! 3233: {
! 3234: ((real8 **) (*((struct_matrice *)
! 3235: (*s_objet_resultat).objet))
! 3236: .tableau)[i][j] += ((real8 **)
! 3237: (*((struct_matrice *)
! 3238: (*s_objet_argument_1).objet)).tableau)[i][k] *
! 3239: ((integer8 **) (*((struct_matrice *)
! 3240: (*s_objet_argument_2).objet)).tableau)[k][j];
! 3241: }
! 3242: else
! 3243: {
! 3244: ((real8 **) (*((struct_matrice *)
! 3245: (*s_objet_resultat).objet))
! 3246: .tableau)[i][j] += ((real8 **)
! 3247: (*((struct_matrice *)
! 3248: (*s_objet_argument_1).objet)).tableau)[i][k] *
! 3249: ((real8 **) (*((struct_matrice *)
! 3250: (*s_objet_argument_2).objet)).tableau)[k][j];
! 3251: }
! 3252: }
! 3253: }
! 3254: }
! 3255: }
! 3256:
! 3257: /*
! 3258: * Matrice d'entiers ou de réels / Matrice de complexes
! 3259: */
! 3260:
! 3261: else if (((*s_objet_argument_1).type == MCX) &&
! 3262: (((*s_objet_argument_2).type == MIN) ||
! 3263: ((*s_objet_argument_2).type == MRL)))
! 3264: {
! 3265: if ((*(((struct_matrice *) (*s_objet_argument_1).objet)))
! 3266: .nombre_colonnes != (*(((struct_matrice *)
! 3267: (*s_objet_argument_2).objet))).nombre_lignes)
! 3268: {
! 3269: liberation(s_etat_processus, s_objet_argument_1);
! 3270: liberation(s_etat_processus, s_objet_argument_2);
! 3271:
! 3272: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
! 3273: return;
! 3274: }
! 3275:
! 3276: if ((s_objet_resultat = allocation(s_etat_processus, MCX)) == NULL)
! 3277: {
! 3278: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 3279: return;
! 3280: }
! 3281:
! 3282: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
! 3283: (*(((struct_matrice *) (*s_objet_argument_2)
! 3284: .objet))).nombre_lignes;
! 3285: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
! 3286: (*(((struct_matrice *) (*s_objet_argument_2)
! 3287: .objet))).nombre_colonnes;
! 3288:
! 3289: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
! 3290: malloc((*((struct_matrice *)
! 3291: (*s_objet_resultat).objet)).nombre_lignes *
! 3292: sizeof(struct_complexe16))) == NULL)
! 3293: {
! 3294: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 3295: return;
! 3296: }
! 3297:
! 3298: if ((*(((struct_matrice *) (*s_objet_argument_1).objet))).nombre_lignes
! 3299: != (*(((struct_matrice *) (*s_objet_argument_1).objet)))
! 3300: .nombre_colonnes)
! 3301: {
! 3302: liberation(s_etat_processus, s_objet_argument_1);
! 3303: liberation(s_etat_processus, s_objet_argument_2);
! 3304: liberation(s_etat_processus, s_objet_resultat);
! 3305:
! 3306: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
! 3307: return;
! 3308: }
! 3309:
! 3310: inversion_matrice(s_etat_processus,
! 3311: (struct_matrice *) (*s_objet_argument_1).objet);
! 3312:
! 3313: if (((*s_etat_processus).exception != d_ep) ||
! 3314: ((*s_etat_processus).erreur_execution != d_ex))
! 3315: {
! 3316: liberation(s_etat_processus, s_objet_argument_1);
! 3317: liberation(s_etat_processus, s_objet_argument_2);
! 3318: liberation(s_etat_processus, s_objet_resultat);
! 3319: return;
! 3320: }
! 3321:
! 3322: if ((*s_etat_processus).erreur_systeme != d_es)
! 3323: {
! 3324: return;
! 3325: }
! 3326:
! 3327: for(i = 0; i < (*((struct_matrice *)
! 3328: (*s_objet_resultat).objet)).nombre_lignes; i++)
! 3329: {
! 3330: if ((((*((struct_matrice *) (*s_objet_resultat).objet)).tableau)[i]
! 3331: = malloc((*((struct_matrice *)
! 3332: (*s_objet_resultat).objet)).nombre_colonnes *
! 3333: sizeof(struct_complexe16))) == NULL)
! 3334: {
! 3335: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 3336: return;
! 3337: }
! 3338:
! 3339: for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat).objet))
! 3340: .nombre_colonnes; j++)
! 3341: {
! 3342: (((struct_complexe16 **) (*((struct_matrice *)
! 3343: (*s_objet_resultat).objet)).tableau)[i][j])
! 3344: .partie_reelle = 0;
! 3345: (((struct_complexe16 **) (*((struct_matrice *)
! 3346: (*s_objet_resultat).objet)).tableau)[i][j])
! 3347: .partie_imaginaire = 0;
! 3348:
! 3349: for(k = 0; k < (*((struct_matrice *) (*s_objet_argument_2)
! 3350: .objet)).nombre_lignes; k++)
! 3351: {
! 3352: if ((*s_objet_argument_2).type == MIN)
! 3353: {
! 3354: f77multiplicationci_(&(((struct_complexe16 **)
! 3355: (*((struct_matrice *) (*s_objet_argument_1)
! 3356: .objet)).tableau)[i][k]), &(((integer8 **)
! 3357: (*((struct_matrice *) (*s_objet_argument_2)
! 3358: .objet)).tableau)[k][j]), &accumulateur);
! 3359:
! 3360: f77additioncc_(&(((struct_complexe16 **)
! 3361: (*((struct_matrice *) (*s_objet_resultat)
! 3362: .objet)).tableau)[i][j]), &accumulateur,
! 3363: &(((struct_complexe16 **) (*((struct_matrice *)
! 3364: (*s_objet_resultat).objet)).tableau)[i][j]));
! 3365: }
! 3366: else
! 3367: {
! 3368: f77multiplicationcr_(&(((struct_complexe16 **)
! 3369: (*((struct_matrice *) (*s_objet_argument_1)
! 3370: .objet)).tableau)[i][k]), &(((real8 **)
! 3371: (*((struct_matrice *) (*s_objet_argument_2)
! 3372: .objet)).tableau)[k][j]), &accumulateur);
! 3373:
! 3374: f77additioncc_(&(((struct_complexe16 **)
! 3375: (*((struct_matrice *) (*s_objet_resultat)
! 3376: .objet)).tableau)[i][j]), &accumulateur,
! 3377: &(((struct_complexe16 **) (*((struct_matrice *)
! 3378: (*s_objet_resultat).objet)).tableau)[i][j]));
! 3379: }
! 3380: }
! 3381: }
! 3382: }
! 3383: }
! 3384:
! 3385: /*
! 3386: * Matrice de complexes / Matrice de complexes
! 3387: */
! 3388:
! 3389: else if (((*s_objet_argument_1).type == MCX) &&
! 3390: ((*s_objet_argument_2).type == MCX))
! 3391: {
! 3392: if ((*(((struct_matrice *) (*s_objet_argument_1).objet)))
! 3393: .nombre_colonnes != (*(((struct_matrice *)
! 3394: (*s_objet_argument_2).objet))).nombre_lignes)
! 3395: {
! 3396: liberation(s_etat_processus, s_objet_argument_1);
! 3397: liberation(s_etat_processus, s_objet_argument_2);
! 3398:
! 3399: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
! 3400: return;
! 3401: }
! 3402:
! 3403: if ((s_objet_resultat = allocation(s_etat_processus, MCX)) == NULL)
! 3404: {
! 3405: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 3406: return;
! 3407: }
! 3408:
! 3409: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
! 3410: (*(((struct_matrice *) (*s_objet_argument_2)
! 3411: .objet))).nombre_lignes;
! 3412: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
! 3413: (*(((struct_matrice *) (*s_objet_argument_2)
! 3414: .objet))).nombre_colonnes;
! 3415:
! 3416: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
! 3417: malloc((*((struct_matrice *)
! 3418: (*s_objet_resultat).objet)).nombre_lignes *
! 3419: sizeof(struct_complexe16))) == NULL)
! 3420: {
! 3421: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 3422: return;
! 3423: }
! 3424:
! 3425: if ((*(((struct_matrice *) (*s_objet_argument_1).objet))).nombre_lignes
! 3426: != (*(((struct_matrice *) (*s_objet_argument_1).objet)))
! 3427: .nombre_colonnes)
! 3428: {
! 3429: liberation(s_etat_processus, s_objet_argument_1);
! 3430: liberation(s_etat_processus, s_objet_argument_2);
! 3431: liberation(s_etat_processus, s_objet_resultat);
! 3432:
! 3433: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
! 3434: return;
! 3435: }
! 3436:
! 3437: inversion_matrice(s_etat_processus,
! 3438: (struct_matrice *) (*s_objet_argument_1).objet);
! 3439:
! 3440: if (((*s_etat_processus).exception != d_ep) ||
! 3441: ((*s_etat_processus).erreur_execution != d_ex))
! 3442: {
! 3443: liberation(s_etat_processus, s_objet_argument_1);
! 3444: liberation(s_etat_processus, s_objet_argument_2);
! 3445: liberation(s_etat_processus, s_objet_resultat);
! 3446: return;
! 3447: }
! 3448:
! 3449: if ((*s_etat_processus).erreur_systeme != d_es)
! 3450: {
! 3451: return;
! 3452: }
! 3453:
! 3454: for(i = 0; i < (*((struct_matrice *)
! 3455: (*s_objet_resultat).objet)).nombre_lignes; i++)
! 3456: {
! 3457: if ((((*((struct_matrice *) (*s_objet_resultat).objet)).tableau)[i]
! 3458: = malloc((*((struct_matrice *)
! 3459: (*s_objet_resultat).objet)).nombre_colonnes *
! 3460: sizeof(struct_complexe16))) == NULL)
! 3461: {
! 3462: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 3463: return;
! 3464: }
! 3465:
! 3466: for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat).objet))
! 3467: .nombre_colonnes; j++)
! 3468: {
! 3469: (((struct_complexe16 **) (*((struct_matrice *)
! 3470: (*s_objet_resultat).objet)).tableau)[i][j])
! 3471: .partie_reelle = 0;
! 3472: (((struct_complexe16 **) (*((struct_matrice *)
! 3473: (*s_objet_resultat).objet)).tableau)[i][j])
! 3474: .partie_imaginaire = 0;
! 3475:
! 3476: for(k = 0; k < (*((struct_matrice *) (*s_objet_argument_2)
! 3477: .objet)).nombre_lignes; k++)
! 3478: {
! 3479: f77multiplicationcc_(&(((struct_complexe16 **)
! 3480: (*((struct_matrice *) (*s_objet_argument_1).objet))
! 3481: .tableau)[i][k]), &(((struct_complexe16 **)
! 3482: (*((struct_matrice *) (*s_objet_argument_2).objet))
! 3483: .tableau)[k][j]), &accumulateur);
! 3484:
! 3485: f77additioncc_(&(((struct_complexe16 **)
! 3486: (*((struct_matrice *) (*s_objet_resultat).objet))
! 3487: .tableau)[i][j]), &accumulateur,
! 3488: &(((struct_complexe16 **)
! 3489: (*((struct_matrice *) (*s_objet_resultat).objet))
! 3490: .tableau)[i][j]));
! 3491: }
! 3492: }
! 3493: }
! 3494: }
! 3495:
! 3496: /*
! 3497: * Matrice de complexes / Matrice d'entiers ou de réels
! 3498: */
! 3499:
! 3500: else if (((*s_objet_argument_2).type == MCX) &&
! 3501: (((*s_objet_argument_1).type == MRL) ||
! 3502: ((*s_objet_argument_1).type == MIN)))
! 3503: {
! 3504: if ((*s_objet_argument_1).type == MIN)
! 3505: {
! 3506: (*s_objet_argument_1).type = MRL;
! 3507: }
! 3508:
! 3509: if ((*(((struct_matrice *) (*s_objet_argument_1).objet)))
! 3510: .nombre_colonnes != (*(((struct_matrice *)
! 3511: (*s_objet_argument_2).objet))).nombre_lignes)
! 3512: {
! 3513: liberation(s_etat_processus, s_objet_argument_1);
! 3514: liberation(s_etat_processus, s_objet_argument_2);
! 3515:
! 3516: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
! 3517: return;
! 3518: }
! 3519:
! 3520: if ((s_objet_resultat = allocation(s_etat_processus, MCX)) == NULL)
! 3521: {
! 3522: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 3523: return;
! 3524: }
! 3525:
! 3526: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
! 3527: (*(((struct_matrice *) (*s_objet_argument_2)
! 3528: .objet))).nombre_lignes;
! 3529: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
! 3530: (*(((struct_matrice *) (*s_objet_argument_2)
! 3531: .objet))).nombre_colonnes;
! 3532:
! 3533: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
! 3534: malloc((*((struct_matrice *)
! 3535: (*s_objet_resultat).objet)).nombre_colonnes *
! 3536: sizeof(struct_complexe16))) == NULL)
! 3537: {
! 3538: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 3539: return;
! 3540: }
! 3541:
! 3542: if ((*(((struct_matrice *) (*s_objet_argument_1).objet))).nombre_lignes
! 3543: != (*(((struct_matrice *) (*s_objet_argument_1).objet)))
! 3544: .nombre_colonnes)
! 3545: {
! 3546: liberation(s_etat_processus, s_objet_argument_1);
! 3547: liberation(s_etat_processus, s_objet_argument_2);
! 3548: liberation(s_etat_processus, s_objet_resultat);
! 3549:
! 3550: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
! 3551: return;
! 3552: }
! 3553:
! 3554: inversion_matrice(s_etat_processus,
! 3555: (struct_matrice *) (*s_objet_argument_1).objet);
! 3556:
! 3557: if (((*s_etat_processus).exception != d_ep) ||
! 3558: ((*s_etat_processus).erreur_execution != d_ex))
! 3559: {
! 3560: liberation(s_etat_processus, s_objet_argument_1);
! 3561: liberation(s_etat_processus, s_objet_argument_2);
! 3562: liberation(s_etat_processus, s_objet_resultat);
! 3563: return;
! 3564: }
! 3565:
! 3566: if ((*s_etat_processus).erreur_systeme != d_es)
! 3567: {
! 3568: return;
! 3569: }
! 3570:
! 3571: for(i = 0; i < (*((struct_matrice *)
! 3572: (*s_objet_resultat).objet)).nombre_lignes; i++)
! 3573: {
! 3574: if ((((*((struct_matrice *) (*s_objet_resultat).objet)).tableau)[i]
! 3575: = malloc((*((struct_matrice *)
! 3576: (*s_objet_resultat).objet)).nombre_colonnes *
! 3577: sizeof(struct_complexe16))) == NULL)
! 3578: {
! 3579: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 3580: return;
! 3581: }
! 3582:
! 3583: for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat).objet))
! 3584: .nombre_colonnes; j++)
! 3585: {
! 3586: (((struct_complexe16 **) (*((struct_matrice *)
! 3587: (*s_objet_resultat).objet)).tableau)[i][j])
! 3588: .partie_reelle = 0;
! 3589: (((struct_complexe16 **) (*((struct_matrice *)
! 3590: (*s_objet_resultat).objet)).tableau)[i][j])
! 3591: .partie_imaginaire = 0;
! 3592:
! 3593: for(k = 0; k < (*((struct_matrice *) (*s_objet_argument_2)
! 3594: .objet)).nombre_lignes; k++)
! 3595: {
! 3596: if ((*s_objet_argument_1).type == MIN)
! 3597: {
! 3598: f77multiplicationci_(&(((struct_complexe16 **)
! 3599: (*((struct_matrice *) (*s_objet_argument_2)
! 3600: .objet)).tableau)[k][j]), &(((integer8 **)
! 3601: (*((struct_matrice *) (*s_objet_argument_1)
! 3602: .objet)).tableau)[i][k]), &accumulateur);
! 3603:
! 3604: f77additioncc_(&(((struct_complexe16 **)
! 3605: (*((struct_matrice *) (*s_objet_resultat)
! 3606: .objet)).tableau)[i][j]), &accumulateur,
! 3607: &(((struct_complexe16 **) (*((struct_matrice *)
! 3608: (*s_objet_resultat).objet))
! 3609: .tableau)[i][j]));
! 3610: }
! 3611: else
! 3612: {
! 3613: f77multiplicationcr_(&(((struct_complexe16 **)
! 3614: (*((struct_matrice *) (*s_objet_argument_2)
! 3615: .objet)).tableau)[k][j]), &(((real8 **)
! 3616: (*((struct_matrice *) (*s_objet_argument_1)
! 3617: .objet)).tableau)[i][k]), &accumulateur);
! 3618:
! 3619: f77additioncc_(&(((struct_complexe16 **)
! 3620: (*((struct_matrice *) (*s_objet_resultat)
! 3621: .objet)).tableau)[i][j]), &accumulateur,
! 3622: &(((struct_complexe16 **) (*((struct_matrice *)
! 3623: (*s_objet_resultat).objet))
! 3624: .tableau)[i][j]));
! 3625: }
! 3626: }
! 3627: }
! 3628: }
! 3629: }
! 3630:
! 3631: /*
! 3632: --------------------------------------------------------------------------------
! 3633: Division mettant en oeuvre des binaires
! 3634: --------------------------------------------------------------------------------
! 3635: */
! 3636: /*
! 3637: * Binaire / Binaire
! 3638: */
! 3639:
! 3640: else if (((*s_objet_argument_1).type == BIN) &&
! 3641: ((*s_objet_argument_2).type == BIN))
! 3642: {
! 3643: if ((s_objet_resultat = allocation(s_etat_processus, BIN)) == NULL)
! 3644: {
! 3645: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 3646: return;
! 3647: }
! 3648:
! 3649: (*((logical8 *) (*s_objet_resultat).objet)) =
! 3650: (*((logical8 *) (*s_objet_argument_2).objet))
! 3651: / (*((logical8 *) (*s_objet_argument_1).objet));
! 3652: }
! 3653:
! 3654: /*
! 3655: * Binaire / Entier
! 3656: */
! 3657:
! 3658: else if ((((*s_objet_argument_1).type == BIN) &&
! 3659: ((*s_objet_argument_2).type == INT)) ||
! 3660: (((*s_objet_argument_1).type == INT) &&
! 3661: ((*s_objet_argument_2).type == BIN)))
! 3662: {
! 3663: if ((s_objet_resultat = allocation(s_etat_processus, BIN)) == NULL)
! 3664: {
! 3665: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 3666: return;
! 3667: }
! 3668:
! 3669: if ((*s_objet_argument_1).type == BIN)
! 3670: {
! 3671: (*((logical8 *) (*s_objet_resultat).objet)) =
! 3672: (*((integer8 *) (*s_objet_argument_2).objet))
! 3673: / (*((logical8 *) (*s_objet_argument_1).objet));
! 3674: }
! 3675: else
! 3676: {
! 3677: (*((logical8 *) (*s_objet_resultat).objet)) =
! 3678: (*((logical8 *) (*s_objet_argument_2).objet))
! 3679: / (*((integer8 *) (*s_objet_argument_1).objet));
! 3680: }
! 3681: }
! 3682:
! 3683: /*
! 3684: --------------------------------------------------------------------------------
! 3685: Division impossible
! 3686: --------------------------------------------------------------------------------
! 3687: */
! 3688:
! 3689: else
! 3690: {
! 3691: liberation(s_etat_processus, s_objet_argument_1);
! 3692: liberation(s_etat_processus, s_objet_argument_2);
! 3693:
! 3694: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 3695: return;
! 3696: }
! 3697:
! 3698: liberation(s_etat_processus, s_objet_argument_1);
! 3699: liberation(s_etat_processus, s_objet_argument_2);
! 3700:
! 3701: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 3702: s_objet_resultat) == d_erreur)
! 3703: {
! 3704: return;
! 3705: }
! 3706:
! 3707: return;
! 3708: }
! 3709:
! 3710:
! 3711: /*
! 3712: ================================================================================
! 3713: Fonction 'do'
! 3714: ================================================================================
! 3715: Entrées : structure processus
! 3716: --------------------------------------------------------------------------------
! 3717: Sorties :
! 3718: --------------------------------------------------------------------------------
! 3719: Effets de bord : néant
! 3720: ================================================================================
! 3721: */
! 3722:
! 3723: void
! 3724: instruction_do(struct_processus *s_etat_processus)
! 3725: {
! 3726: (*s_etat_processus).erreur_execution = d_ex;
! 3727:
! 3728: if ((*s_etat_processus).affichage_arguments == 'Y')
! 3729: {
! 3730: printf("\n DO ");
! 3731:
! 3732: if ((*s_etat_processus).langue == 'F')
! 3733: {
! 3734: printf("(structure de contrôle)\n\n");
! 3735: printf(" Utilisation :\n\n");
! 3736: }
! 3737: else
! 3738: {
! 3739: printf("(control statement)\n\n");
! 3740: printf(" Usage:\n\n");
! 3741: }
! 3742:
! 3743: printf(" DO\n");
! 3744: printf(" (expression 1)\n");
! 3745: printf(" EXIT\n");
! 3746: printf(" (expression 2)\n");
! 3747: printf(" UNTIL\n");
! 3748: printf(" (clause)\n");
! 3749: printf(" END\n\n");
! 3750:
! 3751: printf(" DO\n");
! 3752: printf(" (expression)\n");
! 3753: printf(" UNTIL\n");
! 3754: printf(" (clause)\n");
! 3755: printf(" END\n");
! 3756:
! 3757: return;
! 3758: }
! 3759: else if ((*s_etat_processus).test_instruction == 'Y')
! 3760: {
! 3761: (*s_etat_processus).nombre_arguments = -1;
! 3762: return;
! 3763: }
! 3764:
! 3765: empilement_pile_systeme(s_etat_processus);
! 3766:
! 3767: if ((*s_etat_processus).erreur_systeme != d_es)
! 3768: {
! 3769: return;
! 3770: }
! 3771:
! 3772: (*(*s_etat_processus).l_base_pile_systeme).type_cloture = 'D';
! 3773: (*(*s_etat_processus).l_base_pile_systeme).clause = 'D';
! 3774:
! 3775: if ((*s_etat_processus).mode_execution_programme == 'Y')
! 3776: {
! 3777: (*(*s_etat_processus).l_base_pile_systeme).adresse_retour =
! 3778: (*s_etat_processus).position_courante;
! 3779: }
! 3780: else
! 3781: {
! 3782: if ((*s_etat_processus).expression_courante == NULL)
! 3783: {
! 3784: (*s_etat_processus).erreur_execution =
! 3785: d_ex_erreur_traitement_boucle;
! 3786: return;
! 3787: }
! 3788:
! 3789: (*(*s_etat_processus).l_base_pile_systeme).pointeur_objet_retour =
! 3790: (*s_etat_processus).expression_courante;
! 3791: }
! 3792:
! 3793: return;
! 3794: }
! 3795:
! 3796:
! 3797: /*
! 3798: ================================================================================
! 3799: Fonction 'default'
! 3800: ================================================================================
! 3801: Entrées : structure processus
! 3802: --------------------------------------------------------------------------------
! 3803: Sorties :
! 3804: --------------------------------------------------------------------------------
! 3805: Effets de bord : néant
! 3806: ================================================================================
! 3807: */
! 3808:
! 3809: void
! 3810: instruction_default(struct_processus *s_etat_processus)
! 3811: {
! 3812: logical1 drapeau_fin;
! 3813: logical1 erreur;
! 3814:
! 3815: unsigned char *instruction_majuscule;
! 3816: unsigned char *tampon;
! 3817:
! 3818: unsigned long niveau;
! 3819:
! 3820: (*s_etat_processus).erreur_execution = d_ex;
! 3821:
! 3822: if ((*s_etat_processus).affichage_arguments == 'Y')
! 3823: {
! 3824: printf("\n DEFAULT ");
! 3825:
! 3826: if ((*s_etat_processus).langue == 'F')
! 3827: {
! 3828: printf("(structure de contrôle)\n\n");
! 3829: printf(" Utilisation :\n\n");
! 3830: }
! 3831: else
! 3832: {
! 3833: printf("(control statement)\n\n");
! 3834: printf(" Usage:\n\n");
! 3835: }
! 3836:
! 3837: printf(" SELECT (expression test)\n");
! 3838: printf(" CASE (clause 1) THEN (expression 1) END\n");
! 3839: printf(" CASE (clause 2) THEN (expression 2) END\n");
! 3840: printf(" ...\n");
! 3841: printf(" CASE (clause n) THEN (expression n) END\n");
! 3842: printf(" DEFAULT\n");
! 3843: printf(" (expression)\n");
! 3844: printf(" END\n");
! 3845:
! 3846: return;
! 3847: }
! 3848: else if ((*s_etat_processus).test_instruction == 'Y')
! 3849: {
! 3850: (*s_etat_processus).nombre_arguments = -1;
! 3851: return;
! 3852: }
! 3853:
! 3854: if ((*(*s_etat_processus).l_base_pile_systeme).type_cloture == 'C')
! 3855: {
! 3856: if ((*(*s_etat_processus).l_base_pile_systeme).clause == 'C')
! 3857: {
! 3858: /*
! 3859: * Au moins un cas CASE a été traité et l'on saute au END
! 3860: * correspondant.
! 3861: */
! 3862:
! 3863: tampon = (*s_etat_processus).instruction_courante;
! 3864: niveau = 0;
! 3865:
! 3866: do
! 3867: {
! 3868: if ((*s_etat_processus).mode_execution_programme == 'Y')
! 3869: {
! 3870: erreur = recherche_instruction_suivante(s_etat_processus);
! 3871: }
! 3872: else
! 3873: {
! 3874: erreur = d_absence_erreur;
! 3875:
! 3876: if ((*s_etat_processus).expression_courante != NULL)
! 3877: {
! 3878: while(((*(*(*s_etat_processus)
! 3879: .expression_courante).donnee).type != FCT)
! 3880: && (erreur == d_absence_erreur))
! 3881: {
! 3882: if ((*s_etat_processus).expression_courante == NULL)
! 3883: {
! 3884: erreur = d_erreur;
! 3885: }
! 3886: else
! 3887: {
! 3888: (*s_etat_processus).expression_courante =
! 3889: (*(*s_etat_processus)
! 3890: .expression_courante).suivant;
! 3891: }
! 3892: }
! 3893: }
! 3894: else
! 3895: {
! 3896: erreur = d_erreur;
! 3897: }
! 3898:
! 3899: if (erreur == d_absence_erreur)
! 3900: {
! 3901: if (((*s_etat_processus).instruction_courante =
! 3902: malloc((strlen(
! 3903: (*((struct_fonction *) (*(*(*s_etat_processus)
! 3904: .expression_courante).donnee).objet))
! 3905: .nom_fonction) + 1) * sizeof(unsigned char)))
! 3906: == NULL)
! 3907: {
! 3908: (*s_etat_processus).erreur_systeme =
! 3909: d_es_allocation_memoire;
! 3910: return;
! 3911: }
! 3912:
! 3913: strcpy((*s_etat_processus).instruction_courante,
! 3914: (*((struct_fonction *) (*(*(*s_etat_processus)
! 3915: .expression_courante).donnee).objet))
! 3916: .nom_fonction);
! 3917: }
! 3918: }
! 3919:
! 3920: if (erreur != d_absence_erreur)
! 3921: {
! 3922: if ((*s_etat_processus).instruction_courante != NULL)
! 3923: {
! 3924: free((*s_etat_processus).instruction_courante);
! 3925: }
! 3926:
! 3927: (*s_etat_processus).instruction_courante = tampon;
! 3928: (*s_etat_processus).erreur_execution =
! 3929: d_ex_erreur_traitement_condition;
! 3930:
! 3931: return;
! 3932: }
! 3933:
! 3934: instruction_majuscule = conversion_majuscule(
! 3935: (*s_etat_processus).instruction_courante);
! 3936:
! 3937: if (niveau == 0)
! 3938: {
! 3939: if (strcmp(instruction_majuscule, "END") == 0)
! 3940: {
! 3941: if ((*s_etat_processus).mode_execution_programme == 'Y')
! 3942: {
! 3943: (*s_etat_processus).position_courante -= (strlen(
! 3944: instruction_majuscule) + 1);
! 3945: }
! 3946: else
! 3947: {
! 3948: instruction_end(s_etat_processus);
! 3949: }
! 3950:
! 3951: drapeau_fin = d_vrai;
! 3952: }
! 3953: else
! 3954: {
! 3955: drapeau_fin = d_faux;
! 3956: }
! 3957: }
! 3958: else
! 3959: {
! 3960: drapeau_fin = d_faux;
! 3961: }
! 3962:
! 3963: if ((strcmp(instruction_majuscule, "CASE") == 0) ||
! 3964: (strcmp(instruction_majuscule, "DO") == 0) ||
! 3965: (strcmp(instruction_majuscule, "IF") == 0) ||
! 3966: (strcmp(instruction_majuscule, "IFERR") == 0) ||
! 3967: (strcmp(instruction_majuscule, "SELECT") == 0) ||
! 3968: (strcmp(instruction_majuscule, "WHILE") == 0))
! 3969: {
! 3970: niveau++;
! 3971: }
! 3972: else if (strcmp(instruction_majuscule, "END") == 0)
! 3973: {
! 3974: niveau--;
! 3975: }
! 3976:
! 3977: free(instruction_majuscule);
! 3978: free((*s_etat_processus).instruction_courante);
! 3979:
! 3980: if (((*s_etat_processus).mode_execution_programme != 'Y') &&
! 3981: (drapeau_fin == d_faux))
! 3982: {
! 3983: (*s_etat_processus).expression_courante =
! 3984: (*(*s_etat_processus)
! 3985: .expression_courante).suivant;
! 3986: }
! 3987: } while(drapeau_fin == d_faux);
! 3988:
! 3989: (*s_etat_processus).instruction_courante = tampon;
! 3990: }
! 3991: else
! 3992: {
! 3993: if ((*(*s_etat_processus).l_base_pile_systeme).clause == 'F')
! 3994: {
! 3995: (*s_etat_processus).erreur_execution =
! 3996: d_ex_erreur_traitement_condition;
! 3997: return;
! 3998: }
! 3999:
! 4000: (*(*s_etat_processus).l_base_pile_systeme).clause = 'F';
! 4001: }
! 4002: }
! 4003: else
! 4004: {
! 4005: (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_condition;
! 4006: return;
! 4007: }
! 4008:
! 4009: return;
! 4010: }
! 4011:
! 4012: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_d1.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src