Annotation of rpl/src/instructions_i2.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 'idn'
! 29: ================================================================================
! 30: Entrées : pointeur sur une struct_processus
! 31: --------------------------------------------------------------------------------
! 32: Sorties :
! 33: --------------------------------------------------------------------------------
! 34: Effets de bord : néant
! 35: ================================================================================
! 36: */
! 37:
! 38: void
! 39: instruction_idn(struct_processus *s_etat_processus)
! 40: {
! 41: struct_objet *s_objet_argument;
! 42: struct_objet *s_objet_resultat;
! 43:
! 44: logical1 argument_nom;
! 45: logical1 variable_partagee;
! 46:
! 47: unsigned long i;
! 48: unsigned long j;
! 49:
! 50: (*s_etat_processus).erreur_execution = d_ex;
! 51:
! 52: if ((*s_etat_processus).affichage_arguments == 'Y')
! 53: {
! 54: printf("\n IDN ");
! 55:
! 56: if ((*s_etat_processus).langue == 'F')
! 57: {
! 58: printf("(matrice identité)\n\n");
! 59: }
! 60: else
! 61: {
! 62: printf("(identity matrix)\n\n");
! 63: }
! 64:
! 65: printf(" 1: %s, %s, %s, %s\n",
! 66: d_INT, d_MIN, d_MRL, d_MCX);
! 67: printf("-> 1: %s\n\n", d_MIN);
! 68:
! 69: printf(" 1: %s\n", d_NOM);
! 70: return;
! 71: }
! 72: else if ((*s_etat_processus).test_instruction == 'Y')
! 73: {
! 74: (*s_etat_processus).nombre_arguments = -1;
! 75: return;
! 76: }
! 77:
! 78: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 79: {
! 80: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 81: {
! 82: return;
! 83: }
! 84: }
! 85:
! 86: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 87: &s_objet_argument) == d_erreur)
! 88: {
! 89: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 90: return;
! 91: }
! 92:
! 93: if ((*s_objet_argument).type == NOM)
! 94: {
! 95: argument_nom = d_vrai;
! 96:
! 97: if (recherche_variable(s_etat_processus, (*((struct_nom *)
! 98: (*s_objet_argument).objet)).nom) == d_faux)
! 99: {
! 100: (*s_etat_processus).erreur_systeme = d_es;
! 101: (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
! 102:
! 103: liberation(s_etat_processus, s_objet_argument);
! 104:
! 105: return;
! 106: }
! 107:
! 108: liberation(s_etat_processus, s_objet_argument);
! 109:
! 110: if ((*s_etat_processus).s_liste_variables[(*s_etat_processus)
! 111: .position_variable_courante].variable_verrouillee == d_vrai)
! 112: {
! 113: (*s_etat_processus).erreur_execution = d_ex_variable_verrouillee;
! 114: return;
! 115: }
! 116:
! 117: s_objet_argument = (*s_etat_processus).s_liste_variables
! 118: [(*s_etat_processus).position_variable_courante].objet;
! 119:
! 120: if (s_objet_argument == NULL)
! 121: {
! 122: if (pthread_mutex_lock(&((*(*s_etat_processus)
! 123: .s_liste_variables_partagees).mutex)) != 0)
! 124: {
! 125: (*s_etat_processus).erreur_systeme = d_es_processus;
! 126: return;
! 127: }
! 128:
! 129: if (recherche_variable_partagee(s_etat_processus,
! 130: (*s_etat_processus).s_liste_variables
! 131: [(*s_etat_processus).position_variable_courante].nom,
! 132: (*s_etat_processus).s_liste_variables
! 133: [(*s_etat_processus).position_variable_courante]
! 134: .variable_partagee, (*s_etat_processus).s_liste_variables
! 135: [(*s_etat_processus).position_variable_courante].origine)
! 136: == d_faux)
! 137: {
! 138: if (pthread_mutex_unlock(&((*(*s_etat_processus)
! 139: .s_liste_variables_partagees).mutex)) != 0)
! 140: {
! 141: (*s_etat_processus).erreur_systeme = d_es_processus;
! 142: return;
! 143: }
! 144:
! 145: (*s_etat_processus).erreur_systeme = d_es;
! 146: (*s_etat_processus).erreur_execution =
! 147: d_ex_variable_non_definie;
! 148:
! 149: return;
! 150: }
! 151:
! 152: s_objet_argument = (*(*s_etat_processus)
! 153: .s_liste_variables_partagees).table[(*(*s_etat_processus)
! 154: .s_liste_variables_partagees).position_variable].objet;
! 155: variable_partagee = d_vrai;
! 156: }
! 157: else
! 158: {
! 159: variable_partagee = d_faux;
! 160: }
! 161: }
! 162: else
! 163: {
! 164: argument_nom = d_faux;
! 165: variable_partagee = d_faux;
! 166: }
! 167:
! 168: /*
! 169: --------------------------------------------------------------------------------
! 170: L'argument est la dimension de la matrice identité à créer ou une
! 171: matrice carée dont les dimensions seront prises pour créer une matrice
! 172: identité.
! 173: --------------------------------------------------------------------------------
! 174: */
! 175:
! 176: if (((*s_objet_argument).type == INT) ||
! 177: ((*s_objet_argument).type == MIN) ||
! 178: ((*s_objet_argument).type == MRL) ||
! 179: ((*s_objet_argument).type == MCX))
! 180: {
! 181: if ((s_objet_resultat = allocation(s_etat_processus, MIN))
! 182: == NULL)
! 183: {
! 184: if (variable_partagee == d_vrai)
! 185: {
! 186: if (pthread_mutex_unlock(&((*(*s_etat_processus)
! 187: .s_liste_variables_partagees).mutex)) != 0)
! 188: {
! 189: (*s_etat_processus).erreur_systeme = d_es_processus;
! 190: return;
! 191: }
! 192: }
! 193:
! 194: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 195: return;
! 196: }
! 197:
! 198: if ((*s_objet_argument).type == INT)
! 199: {
! 200: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
! 201: (*((integer8 *) (*s_objet_argument).objet));
! 202: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
! 203: (*((integer8 *) (*s_objet_argument).objet));
! 204: }
! 205: else
! 206: {
! 207: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
! 208: (*((struct_matrice *) (*s_objet_argument).objet))
! 209: .nombre_lignes;
! 210: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
! 211: (*((struct_matrice *) (*s_objet_argument).objet))
! 212: .nombre_colonnes;
! 213:
! 214: if ((*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes
! 215: != (*((struct_matrice *) (*s_objet_resultat).objet))
! 216: .nombre_colonnes)
! 217: {
! 218: if (variable_partagee == d_vrai)
! 219: {
! 220: if (pthread_mutex_unlock(&((*(*s_etat_processus)
! 221: .s_liste_variables_partagees).mutex)) != 0)
! 222: {
! 223: (*s_etat_processus).erreur_systeme = d_es_processus;
! 224: return;
! 225: }
! 226: }
! 227:
! 228: if (argument_nom == d_faux)
! 229: {
! 230: liberation(s_etat_processus, s_objet_argument);
! 231: }
! 232:
! 233: free((struct_matrice *) (*s_objet_resultat).objet);
! 234: free(s_objet_resultat);
! 235:
! 236: (*s_etat_processus).erreur_execution =
! 237: d_ex_dimensions_invalides;
! 238:
! 239: return;
! 240: }
! 241: }
! 242:
! 243: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
! 244: malloc((*((struct_matrice *) (*s_objet_resultat).objet))
! 245: .nombre_lignes * sizeof(integer8 *))) == NULL)
! 246: {
! 247: if (variable_partagee == d_vrai)
! 248: {
! 249: if (pthread_mutex_unlock(&((*(*s_etat_processus)
! 250: .s_liste_variables_partagees).mutex)) != 0)
! 251: {
! 252: (*s_etat_processus).erreur_systeme = d_es_processus;
! 253: return;
! 254: }
! 255: }
! 256:
! 257: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 258: return;
! 259: }
! 260:
! 261: for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
! 262: .nombre_lignes; i++)
! 263: {
! 264: if ((((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
! 265: .objet)).tableau)[i] = malloc((*((struct_matrice *)
! 266: (*s_objet_resultat).objet)).nombre_colonnes *
! 267: sizeof(integer8))) == NULL)
! 268: {
! 269: if (variable_partagee == d_vrai)
! 270: {
! 271: if (pthread_mutex_unlock(&((*(*s_etat_processus)
! 272: .s_liste_variables_partagees).mutex)) != 0)
! 273: {
! 274: (*s_etat_processus).erreur_systeme = d_es_processus;
! 275: return;
! 276: }
! 277: }
! 278:
! 279: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 280: return;
! 281: }
! 282:
! 283: for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat).objet))
! 284: .nombre_colonnes; j++)
! 285: {
! 286: ((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
! 287: .objet)).tableau)[i][j] = (i == j) ? 1 : 0;
! 288: }
! 289: }
! 290: }
! 291:
! 292: /*
! 293: --------------------------------------------------------------------------------
! 294: Réalisation de la fonction IDN impossible
! 295: --------------------------------------------------------------------------------
! 296: */
! 297:
! 298: else
! 299: {
! 300: if (variable_partagee == d_vrai)
! 301: {
! 302: if (pthread_mutex_unlock(&((*(*s_etat_processus)
! 303: .s_liste_variables_partagees).mutex)) != 0)
! 304: {
! 305: (*s_etat_processus).erreur_systeme = d_es_processus;
! 306: return;
! 307: }
! 308: }
! 309:
! 310: liberation(s_etat_processus, s_objet_argument);
! 311:
! 312: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 313: return;
! 314: }
! 315:
! 316: liberation(s_etat_processus, s_objet_argument);
! 317:
! 318: if (argument_nom == d_faux)
! 319: {
! 320: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 321: s_objet_resultat) == d_erreur)
! 322: {
! 323: return;
! 324: }
! 325: }
! 326: else
! 327: {
! 328: if (variable_partagee == d_vrai)
! 329: {
! 330: (*s_etat_processus).s_liste_variables[(*s_etat_processus)
! 331: .position_variable_courante].objet = NULL;
! 332: (*(*s_etat_processus).s_liste_variables_partagees).table
! 333: [(*(*s_etat_processus).s_liste_variables_partagees)
! 334: .position_variable].objet = s_objet_resultat;
! 335:
! 336: if (pthread_mutex_unlock(&((*(*s_etat_processus)
! 337: .s_liste_variables_partagees).mutex)) != 0)
! 338: {
! 339: (*s_etat_processus).erreur_systeme = d_es_processus;
! 340: return;
! 341: }
! 342: }
! 343: else
! 344: {
! 345: (*s_etat_processus).s_liste_variables[(*s_etat_processus)
! 346: .position_variable_courante].objet = s_objet_resultat;
! 347: }
! 348: }
! 349:
! 350: return;
! 351: }
! 352:
! 353:
! 354: /*
! 355: ================================================================================
! 356: Fonction 'IFFT'
! 357: ================================================================================
! 358: Entrées : structure processus
! 359: --------------------------------------------------------------------------------
! 360: Sorties :
! 361: --------------------------------------------------------------------------------
! 362: Effets de bord : néant
! 363: ================================================================================
! 364: */
! 365:
! 366: void
! 367: instruction_ifft(struct_processus *s_etat_processus)
! 368: {
! 369: integer4 erreur;
! 370: integer4 inverse;
! 371: integer4 nombre_colonnes;
! 372: integer4 nombre_lignes;
! 373:
! 374: struct_complexe16 *matrice_f77;
! 375:
! 376: struct_objet *s_objet_argument;
! 377: struct_objet *s_objet_longueur_fft;
! 378: struct_objet *s_objet_resultat;
! 379:
! 380: logical1 presence_longueur_fft;
! 381:
! 382: unsigned long i;
! 383: unsigned long j;
! 384: unsigned long k;
! 385: unsigned long longueur_fft;
! 386:
! 387: (*s_etat_processus).erreur_execution = d_ex;
! 388:
! 389: if ((*s_etat_processus).affichage_arguments == 'Y')
! 390: {
! 391: printf("\n IFFT ");
! 392:
! 393: if ((*s_etat_processus).langue == 'F')
! 394: {
! 395: printf("(transformée de Fourier inverse rapide)\n\n");
! 396: }
! 397: else
! 398: {
! 399: printf("(inverse of fast Fourier transform)\n\n");
! 400: }
! 401:
! 402: printf(" 2: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
! 403: printf(" 1: %s\n", d_INT);
! 404: printf("-> 1: %s\n\n", d_VCX);
! 405:
! 406: printf(" 1: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
! 407: printf("-> 1: %s\n\n", d_VCX);
! 408:
! 409: printf(" 2: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
! 410: printf(" 1: %s\n", d_INT);
! 411: printf("-> 1: %s\n\n", d_MCX);
! 412:
! 413: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
! 414: printf("-> 1: %s\n", d_MCX);
! 415:
! 416: return;
! 417: }
! 418: else if ((*s_etat_processus).test_instruction == 'Y')
! 419: {
! 420: (*s_etat_processus).nombre_arguments = -1;
! 421: return;
! 422: }
! 423:
! 424: /*
! 425: * Il est possible d'imposer une longueur de FFT au premier niveau
! 426: * de la pile.
! 427: */
! 428:
! 429: if ((*s_etat_processus).l_base_pile == NULL)
! 430: {
! 431: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 432: return;
! 433: }
! 434:
! 435: if ((*(*(*s_etat_processus).l_base_pile).donnee).type == INT)
! 436: {
! 437: presence_longueur_fft = d_vrai;
! 438:
! 439: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 440: {
! 441: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
! 442: {
! 443: return;
! 444: }
! 445: }
! 446:
! 447: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 448: &s_objet_longueur_fft) == d_erreur)
! 449: {
! 450: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 451: return;
! 452: }
! 453:
! 454: longueur_fft = (*((integer8 *) (*s_objet_longueur_fft).objet));
! 455:
! 456: liberation(s_etat_processus, s_objet_longueur_fft);
! 457: }
! 458: else
! 459: {
! 460: presence_longueur_fft = d_faux;
! 461: longueur_fft = 0;
! 462:
! 463: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 464: {
! 465: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 466: {
! 467: return;
! 468: }
! 469: }
! 470: }
! 471:
! 472: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 473: &s_objet_argument) == d_erreur)
! 474: {
! 475: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 476: return;
! 477: }
! 478:
! 479: /*
! 480: --------------------------------------------------------------------------------
! 481: Vecteur
! 482: --------------------------------------------------------------------------------
! 483: */
! 484:
! 485: if (((*s_objet_argument).type == VIN) ||
! 486: ((*s_objet_argument).type == VRL) ||
! 487: ((*s_objet_argument).type == VCX))
! 488: {
! 489: if (presence_longueur_fft == d_faux)
! 490: {
! 491: longueur_fft = pow(2, (integer4) ceil(log((real8)
! 492: (*((struct_vecteur *)
! 493: (*s_objet_argument).objet)).taille) / log((real8) 2)));
! 494:
! 495: if ((longueur_fft / ((real8) (*((struct_vecteur *)
! 496: (*s_objet_argument).objet)).taille)) == 2)
! 497: {
! 498: longueur_fft /= 2;
! 499: }
! 500: }
! 501:
! 502: if ((matrice_f77 = malloc(longueur_fft *
! 503: sizeof(struct_complexe16))) == NULL)
! 504: {
! 505: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 506: return;
! 507: }
! 508:
! 509: if ((*s_objet_argument).type == VIN)
! 510: {
! 511: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet))
! 512: .taille; i++)
! 513: {
! 514: matrice_f77[i].partie_reelle = (real8) ((integer8 *)
! 515: (*((struct_vecteur *) (*s_objet_argument).objet))
! 516: .tableau)[i];
! 517: matrice_f77[i].partie_imaginaire = (real8) 0;
! 518: }
! 519: }
! 520: else if ((*s_objet_argument).type == VRL)
! 521: {
! 522: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet))
! 523: .taille; i++)
! 524: {
! 525: matrice_f77[i].partie_reelle = ((real8 *)
! 526: (*((struct_vecteur *) (*s_objet_argument).objet))
! 527: .tableau)[i];
! 528: matrice_f77[i].partie_imaginaire = (real8) 0;
! 529: }
! 530: }
! 531: else
! 532: {
! 533: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet))
! 534: .taille; i++)
! 535: {
! 536: matrice_f77[i].partie_reelle = ((struct_complexe16 *)
! 537: (*((struct_vecteur *) (*s_objet_argument).objet))
! 538: .tableau)[i].partie_reelle;
! 539: matrice_f77[i].partie_imaginaire = ((struct_complexe16 *)
! 540: (*((struct_vecteur *) (*s_objet_argument).objet))
! 541: .tableau)[i].partie_imaginaire;
! 542: }
! 543: }
! 544:
! 545: for(; i < longueur_fft; i++)
! 546: {
! 547: matrice_f77[i].partie_reelle = (real8) 0;
! 548: matrice_f77[i].partie_imaginaire = (real8) 0;
! 549: }
! 550:
! 551: nombre_lignes = 1;
! 552: nombre_colonnes = longueur_fft;
! 553: inverse = -1;
! 554:
! 555: dft(matrice_f77, &nombre_lignes, &nombre_colonnes, &inverse, &erreur);
! 556:
! 557: if (erreur != 0)
! 558: {
! 559: liberation(s_etat_processus, s_objet_argument);
! 560: free(matrice_f77);
! 561:
! 562: (*s_etat_processus).erreur_execution = d_ex_longueur_fft;
! 563: return;
! 564: }
! 565:
! 566: if ((s_objet_resultat = allocation(s_etat_processus, VCX)) == NULL)
! 567: {
! 568: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 569: return;
! 570: }
! 571:
! 572: (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = longueur_fft;
! 573: (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau = matrice_f77;
! 574: }
! 575:
! 576: /*
! 577: --------------------------------------------------------------------------------
! 578: Matrice
! 579: --------------------------------------------------------------------------------
! 580: */
! 581:
! 582: else if (((*s_objet_argument).type == MIN) ||
! 583: ((*s_objet_argument).type == MRL) ||
! 584: ((*s_objet_argument).type == MCX))
! 585: {
! 586: if (presence_longueur_fft == d_faux)
! 587: {
! 588: longueur_fft = pow(2, (integer4) ceil(log((real8)
! 589: (*((struct_matrice *)
! 590: (*s_objet_argument).objet)).nombre_colonnes) /
! 591: log((real8) 2)));
! 592:
! 593: if ((longueur_fft / ((real8) (*((struct_matrice *)
! 594: (*s_objet_argument).objet)).nombre_colonnes)) == 2)
! 595: {
! 596: longueur_fft /= 2;
! 597: }
! 598: }
! 599:
! 600: if ((matrice_f77 = malloc(longueur_fft *
! 601: (*((struct_matrice *) (*s_objet_argument).objet))
! 602: .nombre_lignes * sizeof(struct_complexe16))) == NULL)
! 603: {
! 604: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 605: return;
! 606: }
! 607:
! 608: if ((*s_objet_argument).type == MIN)
! 609: {
! 610: for(k = 0, i = 0; i < (*((struct_matrice *) (*s_objet_argument)
! 611: .objet)).nombre_colonnes; i++)
! 612: {
! 613: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument)
! 614: .objet)).nombre_lignes; j++)
! 615: {
! 616: matrice_f77[k].partie_reelle = (real8) ((integer8 **)
! 617: (*((struct_matrice *) (*s_objet_argument).objet))
! 618: .tableau)[j][i];
! 619: matrice_f77[k++].partie_imaginaire = (real8) 0;
! 620: }
! 621: }
! 622:
! 623: for(; k < longueur_fft * (*((struct_matrice *) (*s_objet_argument)
! 624: .objet)).nombre_lignes; k++)
! 625: {
! 626: matrice_f77[k].partie_reelle = (real8) 0;
! 627: matrice_f77[k].partie_imaginaire = (real8) 0;
! 628: }
! 629: }
! 630: else if ((*s_objet_argument).type == MRL)
! 631: {
! 632: for(k = 0, i = 0; i < (*((struct_matrice *) (*s_objet_argument)
! 633: .objet)).nombre_colonnes; i++)
! 634: {
! 635: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument)
! 636: .objet)).nombre_lignes; j++)
! 637: {
! 638: matrice_f77[k].partie_reelle = ((real8 **)
! 639: (*((struct_matrice *) (*s_objet_argument).objet))
! 640: .tableau)[j][i];
! 641: matrice_f77[k++].partie_imaginaire = (real8) 0;
! 642: }
! 643: }
! 644:
! 645: for(; k < longueur_fft * (*((struct_matrice *) (*s_objet_argument)
! 646: .objet)).nombre_lignes; k++)
! 647: {
! 648: matrice_f77[k].partie_reelle = (real8) 0;
! 649: matrice_f77[k].partie_imaginaire = (real8) 0;
! 650: }
! 651: }
! 652: else
! 653: {
! 654: for(k = 0, i = 0; i < (*((struct_matrice *) (*s_objet_argument)
! 655: .objet)).nombre_colonnes; i++)
! 656: {
! 657: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument)
! 658: .objet)).nombre_lignes; j++)
! 659: {
! 660: matrice_f77[k].partie_reelle = ((struct_complexe16 **)
! 661: (*((struct_matrice *) (*s_objet_argument).objet))
! 662: .tableau)[j][i].partie_reelle;
! 663: matrice_f77[k++].partie_imaginaire =
! 664: ((struct_complexe16 **) (*((struct_matrice *)
! 665: (*s_objet_argument).objet)).tableau)[j][i]
! 666: .partie_imaginaire;
! 667: }
! 668: }
! 669:
! 670: for(; k < longueur_fft * (*((struct_matrice *) (*s_objet_argument)
! 671: .objet)).nombre_lignes; k++)
! 672: {
! 673: matrice_f77[k].partie_reelle = (real8) 0;
! 674: matrice_f77[k].partie_imaginaire = (real8) 0;
! 675: }
! 676: }
! 677:
! 678: nombre_lignes = (*((struct_matrice *) (*s_objet_argument).objet))
! 679: .nombre_lignes;
! 680: nombre_colonnes = longueur_fft;
! 681: inverse = -1;
! 682:
! 683: dft(matrice_f77, &nombre_lignes, &nombre_colonnes, &inverse, &erreur);
! 684:
! 685: if (erreur != 0)
! 686: {
! 687: liberation(s_etat_processus, s_objet_argument);
! 688: free(matrice_f77);
! 689:
! 690: (*s_etat_processus).erreur_execution = d_ex_longueur_fft;
! 691: return;
! 692: }
! 693:
! 694: if ((s_objet_resultat = allocation(s_etat_processus, MCX)) == NULL)
! 695: {
! 696: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 697: return;
! 698: }
! 699:
! 700: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
! 701: (*((struct_matrice *) (*s_objet_argument).objet))
! 702: .nombre_lignes;
! 703: (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
! 704: longueur_fft;
! 705:
! 706: if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
! 707: malloc((*((struct_matrice *) (*s_objet_resultat).objet))
! 708: .nombre_lignes * sizeof(struct_complexe16 *))) == NULL)
! 709: {
! 710: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 711: return;
! 712: }
! 713:
! 714: for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
! 715: .nombre_lignes; i++)
! 716: {
! 717: if ((((struct_complexe16 **) (*((struct_matrice *)
! 718: (*s_objet_resultat).objet)).tableau)[i] =
! 719: malloc((*((struct_matrice *)
! 720: (*s_objet_resultat).objet)).nombre_colonnes *
! 721: sizeof(struct_complexe16))) == NULL)
! 722: {
! 723: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 724: return;
! 725: }
! 726: }
! 727:
! 728: for(k = 0, i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
! 729: .nombre_colonnes; i++)
! 730: {
! 731: for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat).objet))
! 732: .nombre_lignes; j++)
! 733: {
! 734: ((struct_complexe16 **) (*((struct_matrice *)
! 735: (*s_objet_resultat).objet)).tableau)[j][i]
! 736: .partie_reelle = matrice_f77[k].partie_reelle;
! 737: ((struct_complexe16 **) (*((struct_matrice *)
! 738: (*s_objet_resultat).objet)).tableau)[j][i]
! 739: .partie_imaginaire = matrice_f77[k++].partie_imaginaire;
! 740: }
! 741: }
! 742:
! 743: free(matrice_f77);
! 744: }
! 745:
! 746: /*
! 747: --------------------------------------------------------------------------------
! 748: Calcul de FFT impossible
! 749: --------------------------------------------------------------------------------
! 750: */
! 751:
! 752: else
! 753: {
! 754: liberation(s_etat_processus, s_objet_argument);
! 755:
! 756: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 757: return;
! 758: }
! 759:
! 760: liberation(s_etat_processus, s_objet_argument);
! 761:
! 762: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 763: s_objet_resultat) == d_erreur)
! 764: {
! 765: return;
! 766: }
! 767:
! 768: return;
! 769: }
! 770:
! 771:
! 772: /*
! 773: ================================================================================
! 774: Fonction 'input'
! 775: ================================================================================
! 776: Entrées :
! 777: --------------------------------------------------------------------------------
! 778: Sorties :
! 779: --------------------------------------------------------------------------------
! 780: Effets de bord : néant
! 781: ================================================================================
! 782: */
! 783:
! 784: void
! 785: instruction_input(struct_processus *s_etat_processus)
! 786: {
! 787: struct_objet *s_objet_resultat;
! 788:
! 789: unsigned char *tampon;
! 790:
! 791: (*s_etat_processus).erreur_execution = d_ex;
! 792:
! 793: if ((*s_etat_processus).affichage_arguments == 'Y')
! 794: {
! 795: printf("\n INPUT ");
! 796:
! 797: if ((*s_etat_processus).langue == 'F')
! 798: {
! 799: printf("(attente d'une entrée)\n\n");
! 800: }
! 801: else
! 802: {
! 803: printf("(input)\n\n");
! 804: }
! 805:
! 806: printf("-> 1: %s\n", d_CHN);
! 807:
! 808: return;
! 809: }
! 810: else if ((*s_etat_processus).test_instruction == 'Y')
! 811: {
! 812: (*s_etat_processus).nombre_arguments = -1;
! 813: return;
! 814: }
! 815:
! 816: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 817: {
! 818: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 819: {
! 820: return;
! 821: }
! 822: }
! 823:
! 824: if ((s_objet_resultat = allocation(s_etat_processus, CHN)) == NULL)
! 825: {
! 826: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 827: return;
! 828: }
! 829:
! 830: flockfile(stdin);
! 831: (*s_objet_resultat).objet = (void *) readline("");
! 832: funlockfile(stdin);
! 833:
! 834: if ((*s_objet_resultat).objet == NULL)
! 835: {
! 836: if (((*s_objet_resultat).objet = malloc(sizeof(unsigned char)))
! 837: == NULL)
! 838: {
! 839: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 840: return;
! 841: }
! 842:
! 843: (*((unsigned char *) (*s_objet_resultat).objet)) =
! 844: d_code_fin_chaine;
! 845: }
! 846:
! 847: if ((tampon = transliteration(s_etat_processus,
! 848: (unsigned char *) (*s_objet_resultat).objet,
! 849: (*s_etat_processus).localisation, d_locale)) == NULL)
! 850: {
! 851: return;
! 852: }
! 853:
! 854: free((unsigned char *) (*s_objet_resultat).objet);
! 855: (*s_objet_resultat).objet = tampon;
! 856:
! 857: add_history((unsigned char *) (*s_objet_resultat).objet);
! 858: stifle_history(ds_longueur_historique);
! 859:
! 860: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 861: s_objet_resultat) == d_erreur)
! 862: {
! 863: return;
! 864: }
! 865:
! 866: return;
! 867: }
! 868:
! 869:
! 870: /*
! 871: ================================================================================
! 872: Fonction 'indep'
! 873: ================================================================================
! 874: Entrées : pointeur sur une structure struct_processus
! 875: --------------------------------------------------------------------------------
! 876: Sorties :
! 877: --------------------------------------------------------------------------------
! 878: Effets de bord : néant
! 879: ================================================================================
! 880: */
! 881:
! 882: void
! 883: instruction_indep(struct_processus *s_etat_processus)
! 884: {
! 885: struct_liste_chainee *l_element_courant;
! 886:
! 887: struct_objet *s_objet;
! 888:
! 889: (*s_etat_processus).erreur_execution = d_ex;
! 890:
! 891: if ((*s_etat_processus).affichage_arguments == 'Y')
! 892: {
! 893: printf("\n INDEP ");
! 894:
! 895: if ((*s_etat_processus).langue == 'F')
! 896: {
! 897: printf("(indication de la variable indépendante)\n\n");
! 898: }
! 899: else
! 900: {
! 901: printf("(set independant variable)\n\n");
! 902: }
! 903:
! 904: printf(" 1: %s, %s\n", d_NOM, d_LST);
! 905:
! 906: return;
! 907: }
! 908: else if ((*s_etat_processus).test_instruction == 'Y')
! 909: {
! 910: (*s_etat_processus).nombre_arguments = -1;
! 911: return;
! 912: }
! 913:
! 914: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 915: {
! 916: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 917: {
! 918: return;
! 919: }
! 920: }
! 921:
! 922: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 923: &s_objet) == d_erreur)
! 924: {
! 925: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 926: return;
! 927: }
! 928:
! 929: if ((*s_objet).type == NOM)
! 930: {
! 931: liberation(s_etat_processus, (*s_etat_processus).indep);
! 932: (*s_etat_processus).indep = s_objet;
! 933: }
! 934: else if ((*s_objet).type == LST)
! 935: {
! 936: l_element_courant = (struct_liste_chainee *) (*s_objet).objet;
! 937:
! 938: if ((*(*l_element_courant).donnee).type != NOM)
! 939: {
! 940: liberation(s_etat_processus, s_objet);
! 941:
! 942: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
! 943: return;
! 944: }
! 945:
! 946: (*((struct_nom *) (*(*l_element_courant).donnee).objet)).symbole =
! 947: d_vrai;
! 948:
! 949: l_element_courant = (*l_element_courant).suivant;
! 950:
! 951: if (!(((*(*l_element_courant).donnee).type == INT) ||
! 952: ((*(*l_element_courant).donnee).type == REL) ||
! 953: ((*(*l_element_courant).donnee).type == NOM) ||
! 954: ((*(*l_element_courant).donnee).type == ALG) ||
! 955: ((*(*l_element_courant).donnee).type == RPN)))
! 956: {
! 957: liberation(s_etat_processus, s_objet);
! 958:
! 959: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
! 960: return;
! 961: }
! 962:
! 963: l_element_courant = (*l_element_courant).suivant;
! 964:
! 965: if (!(((*(*l_element_courant).donnee).type == INT) ||
! 966: ((*(*l_element_courant).donnee).type == REL) ||
! 967: ((*(*l_element_courant).donnee).type == NOM) ||
! 968: ((*(*l_element_courant).donnee).type == ALG) ||
! 969: ((*(*l_element_courant).donnee).type == RPN)))
! 970: {
! 971: liberation(s_etat_processus, s_objet);
! 972:
! 973: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
! 974: return;
! 975: }
! 976:
! 977: l_element_courant = (*l_element_courant).suivant;
! 978:
! 979: if (l_element_courant != NULL)
! 980: {
! 981: liberation(s_etat_processus, s_objet);
! 982:
! 983: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
! 984: return;
! 985: }
! 986:
! 987: liberation(s_etat_processus, (*s_etat_processus).indep);
! 988: (*s_etat_processus).indep = s_objet;
! 989: }
! 990: else
! 991: {
! 992: liberation(s_etat_processus, s_objet);
! 993:
! 994: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 995: return;
! 996: }
! 997:
! 998: return;
! 999: }
! 1000:
! 1001:
! 1002: /*
! 1003: ================================================================================
! 1004: Fonction 'int'
! 1005: ================================================================================
! 1006: Entrées : pointeur sur une struct_processus
! 1007: --------------------------------------------------------------------------------
! 1008: Sorties :
! 1009: --------------------------------------------------------------------------------
! 1010: Effets de bord : néant
! 1011: ================================================================================
! 1012: */
! 1013:
! 1014: void
! 1015: instruction_int(struct_processus *s_etat_processus)
! 1016: {
! 1017: logical1 last_valide;
! 1018:
! 1019: real8 borne_maximale;
! 1020: real8 borne_minimale;
! 1021: real8 precision;
! 1022:
! 1023: struct_liste_chainee *l_element_courant;
! 1024:
! 1025: struct_objet *s_objet_argument_1;
! 1026: struct_objet *s_objet_argument_2;
! 1027: struct_objet *s_objet_argument_3;
! 1028: struct_objet *s_objet_evalue;
! 1029:
! 1030: unsigned char *nom_variable;
! 1031:
! 1032: (*s_etat_processus).erreur_execution = d_ex;
! 1033:
! 1034: if ((*s_etat_processus).affichage_arguments == 'Y')
! 1035: {
! 1036: printf("\n INT ");
! 1037:
! 1038: if ((*s_etat_processus).langue == 'F')
! 1039: {
! 1040: printf("(intégration numérique)\n\n");
! 1041: }
! 1042: else
! 1043: {
! 1044: printf("(numerical integration)\n\n");
! 1045: }
! 1046:
! 1047: printf(" 3: %s, %s, %s\n", d_NOM, d_ALG, d_RPN);
! 1048: printf(" 2: %s\n", d_LST);
! 1049: printf(" 1: %s, %s\n", d_INT, d_REL);
! 1050: printf("-> 2: %s, %s\n", d_INT, d_REL);
! 1051: printf(" 1: %s, %s\n", d_INT, d_REL);
! 1052:
! 1053: return;
! 1054: }
! 1055: else if ((*s_etat_processus).test_instruction == 'Y')
! 1056: {
! 1057: (*s_etat_processus).nombre_arguments = 3;
! 1058: return;
! 1059: }
! 1060:
! 1061: if ((last_valide = test_cfsf(s_etat_processus, 31)) == d_vrai)
! 1062: {
! 1063: if (empilement_pile_last(s_etat_processus, 3) == d_erreur)
! 1064: {
! 1065: return;
! 1066: }
! 1067: }
! 1068:
! 1069: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1070: &s_objet_argument_1) == d_erreur)
! 1071: {
! 1072: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 1073: return;
! 1074: }
! 1075:
! 1076: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1077: &s_objet_argument_2) == d_erreur)
! 1078: {
! 1079: liberation(s_etat_processus, s_objet_argument_1);
! 1080:
! 1081: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 1082: return;
! 1083: }
! 1084:
! 1085: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1086: &s_objet_argument_3) == d_erreur)
! 1087: {
! 1088: liberation(s_etat_processus, s_objet_argument_1);
! 1089: liberation(s_etat_processus, s_objet_argument_2);
! 1090:
! 1091: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 1092: return;
! 1093: }
! 1094:
! 1095: if ((*s_objet_argument_1).type == INT)
! 1096: {
! 1097: precision = (*((integer8 *) (*s_objet_argument_1).objet));
! 1098: }
! 1099: else if ((*s_objet_argument_1).type == REL)
! 1100: {
! 1101: precision = (*((real8 *) (*s_objet_argument_1).objet));
! 1102: }
! 1103: else
! 1104: {
! 1105: liberation(s_etat_processus, s_objet_argument_1);
! 1106: liberation(s_etat_processus, s_objet_argument_2);
! 1107: liberation(s_etat_processus, s_objet_argument_3);
! 1108:
! 1109: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 1110: return;
! 1111: }
! 1112:
! 1113: if ((*s_objet_argument_2).type == LST)
! 1114: {
! 1115: l_element_courant = (*s_objet_argument_2).objet;
! 1116:
! 1117: if ((*(*l_element_courant).donnee).type != NOM)
! 1118: {
! 1119: liberation(s_etat_processus, s_objet_argument_1);
! 1120: liberation(s_etat_processus, s_objet_argument_2);
! 1121: liberation(s_etat_processus, s_objet_argument_3);
! 1122:
! 1123: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 1124: return;
! 1125: }
! 1126:
! 1127: if ((nom_variable = malloc((strlen((*((struct_nom *)
! 1128: (*(*l_element_courant).donnee).objet)).nom)
! 1129: + 1) * sizeof(unsigned char))) == NULL)
! 1130: {
! 1131: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1132: return;
! 1133: }
! 1134:
! 1135: strcpy(nom_variable, (*((struct_nom *) (*(*l_element_courant)
! 1136: .donnee).objet)).nom);
! 1137:
! 1138: l_element_courant = (*l_element_courant).suivant;
! 1139:
! 1140: if ((*(*l_element_courant).donnee).type == INT)
! 1141: {
! 1142: borne_minimale = (real8) (*((integer8 *)
! 1143: (*(*l_element_courant).donnee).objet));
! 1144: }
! 1145: else if ((*(*l_element_courant).donnee).type == REL)
! 1146: {
! 1147: borne_minimale = (*((real8 *) (*(*l_element_courant)
! 1148: .donnee).objet));
! 1149: }
! 1150: else
! 1151: {
! 1152: if (evaluation(s_etat_processus, (*l_element_courant).donnee,
! 1153: 'N') == d_erreur)
! 1154: {
! 1155: free(nom_variable);
! 1156: liberation(s_etat_processus, s_objet_argument_1);
! 1157: liberation(s_etat_processus, s_objet_argument_2);
! 1158: liberation(s_etat_processus, s_objet_argument_3);
! 1159:
! 1160: return;
! 1161: }
! 1162:
! 1163: if (depilement(s_etat_processus, &((*s_etat_processus)
! 1164: .l_base_pile), &s_objet_evalue) == d_erreur)
! 1165: {
! 1166: free(nom_variable);
! 1167: liberation(s_etat_processus, s_objet_argument_1);
! 1168: liberation(s_etat_processus, s_objet_argument_2);
! 1169: liberation(s_etat_processus, s_objet_argument_3);
! 1170:
! 1171: (*s_etat_processus).erreur_execution =
! 1172: d_ex_manque_argument;
! 1173: return;
! 1174: }
! 1175:
! 1176: if ((*s_objet_evalue).type == INT)
! 1177: {
! 1178: borne_minimale = (real8) (*((integer8 *)
! 1179: (*s_objet_evalue).objet));
! 1180: }
! 1181: else if ((*s_objet_evalue).type == REL)
! 1182: {
! 1183: borne_minimale = (*((real8 *) (*s_objet_evalue).objet));
! 1184: }
! 1185: else
! 1186: {
! 1187: free(nom_variable);
! 1188:
! 1189: liberation(s_etat_processus, s_objet_evalue);
! 1190: liberation(s_etat_processus, s_objet_argument_1);
! 1191: liberation(s_etat_processus, s_objet_argument_2);
! 1192: liberation(s_etat_processus, s_objet_argument_3);
! 1193:
! 1194: (*s_etat_processus).erreur_execution =
! 1195: d_ex_erreur_type_argument;
! 1196: return;
! 1197: }
! 1198:
! 1199: liberation(s_etat_processus, s_objet_evalue);
! 1200: }
! 1201:
! 1202: l_element_courant = (*l_element_courant).suivant;
! 1203:
! 1204: if ((*(*l_element_courant).donnee).type == INT)
! 1205: {
! 1206: borne_maximale = (real8) (*((integer8 *)
! 1207: (*(*l_element_courant).donnee).objet));
! 1208: }
! 1209: else if ((*(*l_element_courant).donnee).type == REL)
! 1210: {
! 1211: borne_maximale = (*((real8 *) (*(*l_element_courant)
! 1212: .donnee).objet));
! 1213: }
! 1214: else
! 1215: {
! 1216: if (evaluation(s_etat_processus, (*l_element_courant).donnee,
! 1217: 'N') == d_erreur)
! 1218: {
! 1219: free(nom_variable);
! 1220: liberation(s_etat_processus, s_objet_argument_1);
! 1221: liberation(s_etat_processus, s_objet_argument_2);
! 1222: liberation(s_etat_processus, s_objet_argument_3);
! 1223:
! 1224: return;
! 1225: }
! 1226:
! 1227: if (depilement(s_etat_processus, &((*s_etat_processus)
! 1228: .l_base_pile), &s_objet_evalue) == d_erreur)
! 1229: {
! 1230: free(nom_variable);
! 1231: liberation(s_etat_processus, s_objet_argument_1);
! 1232: liberation(s_etat_processus, s_objet_argument_2);
! 1233: liberation(s_etat_processus, s_objet_argument_3);
! 1234:
! 1235: (*s_etat_processus).erreur_execution =
! 1236: d_ex_manque_argument;
! 1237: return;
! 1238: }
! 1239:
! 1240: if ((*s_objet_evalue).type == INT)
! 1241: {
! 1242: borne_maximale = (real8) (*((integer8 *)
! 1243: (*s_objet_evalue).objet));
! 1244: }
! 1245: else if ((*s_objet_evalue).type == REL)
! 1246: {
! 1247: borne_maximale = (*((real8 *) (*s_objet_evalue).objet));
! 1248: }
! 1249: else
! 1250: {
! 1251: free(nom_variable);
! 1252:
! 1253: liberation(s_etat_processus, s_objet_evalue);
! 1254: liberation(s_etat_processus, s_objet_argument_1);
! 1255: liberation(s_etat_processus, s_objet_argument_2);
! 1256: liberation(s_etat_processus, s_objet_argument_3);
! 1257:
! 1258: (*s_etat_processus).erreur_execution =
! 1259: d_ex_erreur_type_argument;
! 1260: return;
! 1261: }
! 1262:
! 1263: liberation(s_etat_processus, s_objet_evalue);
! 1264: }
! 1265:
! 1266: /*
! 1267: * Le résultat est retourné sur la pile par la routine
! 1268: */
! 1269:
! 1270: if (last_valide == d_vrai)
! 1271: {
! 1272: cf(s_etat_processus, 31);
! 1273: }
! 1274:
! 1275: integrale_romberg(s_etat_processus, s_objet_argument_3, nom_variable,
! 1276: borne_minimale, borne_maximale, precision);
! 1277:
! 1278: if (last_valide == d_vrai)
! 1279: {
! 1280: sf(s_etat_processus, 31);
! 1281: }
! 1282:
! 1283: free(nom_variable);
! 1284: }
! 1285: else
! 1286: {
! 1287: liberation(s_etat_processus, s_objet_argument_1);
! 1288: liberation(s_etat_processus, s_objet_argument_2);
! 1289: liberation(s_etat_processus, s_objet_argument_3);
! 1290:
! 1291: (*s_etat_processus).erreur_execution =
! 1292: d_ex_erreur_type_argument;
! 1293: return;
! 1294: }
! 1295:
! 1296: liberation(s_etat_processus, s_objet_argument_1);
! 1297: liberation(s_etat_processus, s_objet_argument_2);
! 1298: liberation(s_etat_processus, s_objet_argument_3);
! 1299:
! 1300: return;
! 1301: }
! 1302:
! 1303:
! 1304: /*
! 1305: ================================================================================
! 1306: Fonction 'incr'
! 1307: ================================================================================
! 1308: Entrées :
! 1309: --------------------------------------------------------------------------------
! 1310: Sorties :
! 1311: --------------------------------------------------------------------------------
! 1312: Effets de bord : néant
! 1313: ================================================================================
! 1314: */
! 1315:
! 1316: void
! 1317: instruction_incr(struct_processus *s_etat_processus)
! 1318: {
! 1319: logical1 variable_partagee;
! 1320:
! 1321: struct_objet *s_copie_argument;
! 1322: struct_objet *s_objet_argument;
! 1323:
! 1324: (*s_etat_processus).erreur_execution = d_ex;
! 1325:
! 1326: if ((*s_etat_processus).affichage_arguments == 'Y')
! 1327: {
! 1328: printf("\n INCR ");
! 1329:
! 1330: if ((*s_etat_processus).langue == 'F')
! 1331: {
! 1332: printf("(incrémentation)\n\n");
! 1333: }
! 1334: else
! 1335: {
! 1336: printf("(incrementation)\n\n");
! 1337: }
! 1338:
! 1339: printf(" 1: %s\n", d_INT);
! 1340: printf("-> 1: %s\n\n", d_INT);
! 1341:
! 1342: printf(" 1: %s\n", d_NOM);
! 1343:
! 1344: return;
! 1345: }
! 1346: else if ((*s_etat_processus).test_instruction == 'Y')
! 1347: {
! 1348: (*s_etat_processus).nombre_arguments = -1;
! 1349: return;
! 1350: }
! 1351:
! 1352: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 1353: {
! 1354: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 1355: {
! 1356: return;
! 1357: }
! 1358: }
! 1359:
! 1360: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1361: &s_objet_argument) == d_erreur)
! 1362: {
! 1363: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 1364: return;
! 1365: }
! 1366:
! 1367: if ((*s_objet_argument).type == INT)
! 1368: {
! 1369: if ((s_copie_argument = copie_objet(s_etat_processus,
! 1370: s_objet_argument, 'O')) == NULL)
! 1371: {
! 1372: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1373: return;
! 1374: }
! 1375:
! 1376: liberation(s_etat_processus, s_objet_argument);
! 1377: s_objet_argument = s_copie_argument;
! 1378:
! 1379: (*((integer8 *) (*s_objet_argument).objet))++;
! 1380:
! 1381: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1382: s_objet_argument) == d_erreur)
! 1383: {
! 1384: return;
! 1385: }
! 1386: }
! 1387: else if ((*s_objet_argument).type == NOM)
! 1388: {
! 1389: if (recherche_variable(s_etat_processus, (*((struct_nom *)
! 1390: (*s_objet_argument).objet)).nom) == d_faux)
! 1391: {
! 1392: (*s_etat_processus).erreur_systeme = d_es;
! 1393: (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
! 1394:
! 1395: return;
! 1396: }
! 1397:
! 1398: liberation(s_etat_processus, s_objet_argument);
! 1399:
! 1400: if ((*s_etat_processus).s_liste_variables
! 1401: [(*s_etat_processus).position_variable_courante]
! 1402: .variable_verrouillee == d_vrai)
! 1403: {
! 1404: (*s_etat_processus).erreur_execution = d_ex_variable_verrouillee;
! 1405: return;
! 1406: }
! 1407:
! 1408: if ((*s_etat_processus).s_liste_variables
! 1409: [(*s_etat_processus).position_variable_courante].objet
! 1410: == NULL)
! 1411: {
! 1412: if (pthread_mutex_lock(&((*(*s_etat_processus)
! 1413: .s_liste_variables_partagees).mutex)) != 0)
! 1414: {
! 1415: (*s_etat_processus).erreur_systeme = d_es_processus;
! 1416: return;
! 1417: }
! 1418:
! 1419: if (recherche_variable_partagee(s_etat_processus,
! 1420: (*s_etat_processus).s_liste_variables
! 1421: [(*s_etat_processus).position_variable_courante].nom,
! 1422: (*s_etat_processus).s_liste_variables
! 1423: [(*s_etat_processus).position_variable_courante]
! 1424: .variable_partagee, (*s_etat_processus).s_liste_variables
! 1425: [(*s_etat_processus).position_variable_courante]
! 1426: .origine) == d_faux)
! 1427: {
! 1428: (*s_etat_processus).erreur_systeme = d_es;
! 1429: (*s_etat_processus).erreur_execution =
! 1430: d_ex_variable_non_definie;
! 1431:
! 1432: return;
! 1433: }
! 1434:
! 1435: s_objet_argument = (*(*s_etat_processus)
! 1436: .s_liste_variables_partagees).table
! 1437: [(*(*s_etat_processus).s_liste_variables_partagees)
! 1438: .position_variable].objet;
! 1439: variable_partagee = d_vrai;
! 1440: }
! 1441: else
! 1442: {
! 1443: s_objet_argument = (*s_etat_processus).s_liste_variables
! 1444: [(*s_etat_processus).position_variable_courante].objet;
! 1445: variable_partagee = d_faux;
! 1446: }
! 1447:
! 1448: if ((s_copie_argument = copie_objet(s_etat_processus,
! 1449: s_objet_argument, 'O')) == NULL)
! 1450: {
! 1451: if (variable_partagee == d_vrai)
! 1452: {
! 1453: if (pthread_mutex_unlock(&((*(*s_etat_processus)
! 1454: .s_liste_variables_partagees).mutex)) != 0)
! 1455: {
! 1456: (*s_etat_processus).erreur_systeme = d_es_processus;
! 1457: return;
! 1458: }
! 1459: }
! 1460:
! 1461: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1462: return;
! 1463: }
! 1464:
! 1465: liberation(s_etat_processus, s_objet_argument);
! 1466:
! 1467: if (variable_partagee == d_vrai)
! 1468: {
! 1469: (*s_etat_processus).s_liste_variables[(*s_etat_processus)
! 1470: .position_variable_courante].objet = NULL;
! 1471: (*(*s_etat_processus)
! 1472: .s_liste_variables_partagees).table
! 1473: [(*(*s_etat_processus).s_liste_variables_partagees)
! 1474: .position_variable].objet = s_copie_argument;
! 1475: }
! 1476: else
! 1477: {
! 1478: (*s_etat_processus).s_liste_variables[(*s_etat_processus)
! 1479: .position_variable_courante].objet = s_copie_argument;
! 1480: }
! 1481:
! 1482: if ((*s_copie_argument).type == INT)
! 1483: {
! 1484: (*((integer8 *) (*s_copie_argument).objet))++;
! 1485:
! 1486: if (variable_partagee == d_vrai)
! 1487: {
! 1488: if (pthread_mutex_unlock(&((*(*s_etat_processus)
! 1489: .s_liste_variables_partagees).mutex)) != 0)
! 1490: {
! 1491: (*s_etat_processus).erreur_systeme = d_es_processus;
! 1492: return;
! 1493: }
! 1494: }
! 1495: }
! 1496: else
! 1497: {
! 1498: if (variable_partagee == d_vrai)
! 1499: {
! 1500: if (pthread_mutex_unlock(&((*(*s_etat_processus)
! 1501: .s_liste_variables_partagees).mutex)) != 0)
! 1502: {
! 1503: (*s_etat_processus).erreur_systeme = d_es_processus;
! 1504: return;
! 1505: }
! 1506: }
! 1507:
! 1508: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 1509: return;
! 1510: }
! 1511: }
! 1512: else
! 1513: {
! 1514: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 1515:
! 1516: liberation(s_etat_processus, s_objet_argument);
! 1517: return;
! 1518: }
! 1519:
! 1520: return;
! 1521: }
! 1522:
! 1523: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_i2.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src