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